Excel Makro - pojmenování oblasti buněk a odkazování

[honz/a]

Co je špatného na tom, že chci oblast A11:A210 pojmenovat "kod" a pak tam vygenerovat nějaké hesla, jenže nevím správnou syntaxy - ted to nefunguje, pokud je misto "kod" psáno A11:A210 - vše funguje

Pak chci do oblasti "kod" doplnit vzorec a převedu na hodnoty, pole chci definovat zvlášt, protože pole "kod" bude proměnné délky. Nyní délka 200.
Dále chci navrhnout fci, která bude generovat heslo zadané délky. Nyní délka 7 s mezerou po druhém místě - vzor "11 W72G2".

Kód: Vybrat vše

kod = Range("A11:A210")
   
    'doplnění vzorce a převedení na hodnoty je
    Range("kod").FormulaLocal = "=KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&ZNAK(32)&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))"
    Range("kod").Value = Range("kod").Value
   

[Reklama]

[cmuch]

Jsou více možností jak to zapsat (Pokud jak to máš Ty tak zadávat bez uvozovek).

Kód: Vybrat vše

Dim kod As Range

Set kod = Range("A11:A210")
   
    'doplnění vzorce a převedení na hodnoty je
    kod.FormulaLocal = "=KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&ZNAK(32)&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))"
    kod.Value = kod.Value
   

Kód: Vybrat vše

kod = "A11:A210"
   
    'doplnění vzorce a převedení na hodnoty je
    Range(kod).FormulaLocal = "=KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&ZNAK(32)&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))"
    Range(kod).Value = Range(kod).Value

[honz/a]

výborně, to funguje ale další otázka je pro to jak udělet proměnný počet znaků.

pro 5 znáků mám pevný vzorec:

Kód: Vybrat vše

  kod.FormulaLocal = "=KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))&KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))"
   kod.Value = kod.Value

chtěl jsem udělat to samé s možností volby počtu znaků pomocí forcyklu:

Kód: Vybrat vše

For b = 1 To c
        For a = 1 To pocetznaku
            bradek = b + 10
            Range("B" & bradek).FormulaLocal = "=KDYŽ(ZAOKROUHLIT(NÁHČÍSLO();0)=0;ZNAK(RANDBETWEEN(65;90));ZNAK(RANDBETWEEN(49;57)))"
            achar = Range("B" & bradek).Value
            avysledek = avysledek & achar
        Next a
        Range("A" & bradek) = avysledek
        avysledek = ""
    Next b

tj, že by se podmínka když opakovala tolikrát kolika místný kod potřebuju, ALE: první možnost trvá 1 sekundu, druhý forcyklus trvá 61 sekund na tom samém zadání??? (zadání bylo vygenerovat 100x pěti mítstný kód 100 za sebou)


takže asi bude lepší udělat příkaz case:
pro 1 znak = 1x když
pro 2 znaky = 2x
atd. NEBO má někdo nějaký jiný nápad, který by byl efektivnější na čas. fotcyklus to udělal 61 x pomalejší, což jsem opravdu nečekal

[cmuch]

No umě to trvá ani ne okamžik s 20 znaky a 50 řádky.

Zkus toto, nevytváří se vzorec na listu, určitě bude rychlejší.

Kód: Vybrat vše

For b = 1 To c
        For a = 1 To pocetznaku
            bradek = b + 10
            If Round(Rnd(), 0) = 0 Then
                achar = Chr(WorksheetFunction.RandBetween(65, 90))
            Else
                achar = Chr(WorksheetFunction.RandBetween(49, 57))
            End If
            avysledek = avysledek & achar
        Next a
        Range("A" & bradek) = avysledek
        avysledek = ""
    Next b

[honz/a]

ok vyzkouším, ale tak nemyslím si, že bys měl rychlejší procesor než je i5-3570 a já to opakoval celou tu proceduru 100x ještě za sebou

tak po testu

pevný vzorec: 2 s
tvůj návrh: 11 s
můj forcyklus: 61 s

asi udělám ten case, ale pořád nechápu proč pevný vzorec je rychlejší, když dělá to samé :( než forcykl i tak moc děkuju, něco jsem se zase naučil

zajímavé je také,že když generuju jen sto dvojmístncý kodu 50x za sebou čas je 5 sekund a že když generuju jen sto 30místných kodu 50x za sebou čas je 7 sekund

[cmuch]

Já mám jen 3,2GhZ Athlona
Se zadáním 200 200místných kódu trvá v průměru 630ms

Kód: Vybrat vše

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub testTimer()
Dim t As Long
t = GetTickCount

For b = 1 To 200
        For a = 1 To 200
            bradek = b + 10
            If Round(Rnd(), 0) = 0 Then
                achar = Chr(WorksheetFunction.RandBetween(65, 90))
            Else
                achar = Chr(WorksheetFunction.RandBetween(49, 57))
            End If
            avysledek = avysledek & achar
        Next a
        Range("A" & bradek) = avysledek
        avysledek = ""
    Next b

MsgBox GetTickCount - t, , "Milliseconds"
End Sub

Pokud použiji tvůj kód tak asi 8,5s

[honz/a]

ok, tak já tě pošlu celý ten můj excel a zkus tedy test na listu "pokus" zmáčknout "repeat test" pro přednastavené hodnoty 200 čísel, 200x za sebou, 200 místné - tento test mi trvá teď 1:32

určitě věřím, že si lepší programátor, zkus to tedy optimalizovat a já to tvoje pak zkusím,jen se ještě musí zachovat: zjištuje se zda nějaké dva kody jsou shodné přes řazení a přes nějaké porovnávání + se tam počítá pravděpodobnost, sleduju třeba kolika místných kodu se vyskytují dva kody stejné za předpokladu, že chci nějakou malou pravděpodobnost, atd....

[lubo.]

Zkus něco takového:

Kód: Vybrat vše

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub testTimer()
Dim hesla() As Variant
Dim a As Long
Dim b As Long
Dim avysledek As String

Dim t As Long
 
  t = GetTickCount

   ReDim hesla(200, 1)

   For b = LBound(hesla, 1) To UBound(hesla, 1)
      avysledek = ""
      For a = 1 To 200
         If Rnd() < 0.5 Then
            achar = Chr(CInt(Rnd() * 26 + 65))
         Else
            achar = Chr(CInt(Rnd() * 9 + 49))
         End If
         avysledek = avysledek & achar
      Next a
      hesla(b, 1) = avysledek
   Next b
   Range("A10:A210").Value2 = hesla

   MsgBox GetTickCount - t, , "Milliseconds"
End Sub

--- Doplnění předchozího příspěvku (12 Led 2014 23:34) ---

udělám ten case, ale pořád nechápu proč pevný vzorec je rychlejší, když dělá to samé :( než forcykl i tak moc děkuju, něco jsem se zase naučil

Protože vzorec doplňuješ do oblasti jediným příkazem, cmuch do buňky leze 200xn navíc nedeklaruje proměnné -> operace jsou pomalejší, navíc volá funkce listu i tam, kde lze napsat jednoduchý výraz, ...

zajímavé je také,že když generuju jen sto dvojmístncý kodu 50x za sebou čas je 5 sekund a že když generuju jen sto 30místných kodu 50x za sebou čas je 7 sekund

Protože procesor mění rychlost podle zatížení. Na začátku se rozbíhá pomalu, pak přidá. Zkus nastavit procesor před začátkem měření na maximální výkon. + časové nároky se liší.

[honz/a]

lubo máš pravdu v tom, že úprava

Kód: Vybrat vše

achar = Chr(CInt(Rnd() * 25 + 65))
         Else
            achar = Chr(CInt(Rnd() * 8 + 49))

je mnohem efektivnější než

Kód: Vybrat vše

achar = Chr(WorksheetFunction.RandBetween(65, 90))

, to tvoje je zhruba 2x rychlejší, ale musel jsem upravit to násobení (za 26 dát 25 a za 9 dát , jinak to házelo i znaky ":" a "]". V excelu jako vzorce to fungovalo správně viz list1 ...


to s tím časem mi nefunguje, tak jsem to musel dát pryč, mám Win 7 - 64 bit, ale zavedl jsem si tam já něco podobného.

ted to celé je v listu "gen" a dělá to, to co potřebuji, tj. zjištuje to pravděpodnost. Celkově došlo ke zpomalení, ale to bude tím mým řazením, ještě zkusím najít proceduru na řazení pole, nebo kde by ještě mohla být slabina?

např:

Kód: Vybrat vše

Public Function AbecedníSeřazeníPole(pole, Optional l, Optional r)
'Provede abecední seřazení pole a vrátí je v seřazené podobě.
'VB ale neřadí správně podle české abecedy; "z" je pro něj menší než "ř" či "é".

'Převzato s malými změnami z knihy Kocich, Pavel - Gürtler, Martin,
'1001 tipů a triků pro Visual Basic, 308-309.
'DZ dodal optional, aby nebylo nutné l a r posílat; pokud chybí, je přiřazeno.

'Kontrola, zda jde o pole.
If Not IsArray(pole) Then
    MsgBox "Nejde o pole."
    Exit Function
End If
If IsMissing(l) Then l = LBound(pole)
If IsMissing(r) Then r = UBound(pole)
i = l
j = r
x = pole((l + r) / 2)
Do
Do While pole(i) < x
    i = i + 1
Loop
Do While pole(j) > x
    j = j - 1
Loop
If i <= j Then
    tmp = pole(i)
    pole(i) = pole(j)
    pole(j) = tmp
    i = i + 1
    j = j - 1
End If
Loop Until i > j
If l < j Then Call AbecedníSeřazeníPole(pole, l, j)
If i < r Then Call AbecedníSeřazeníPole(pole, i, r)
End Function

[cmuch]

achar = Chr(CInt(Rnd() * 25 + 65))
Else
achar = Chr(CInt(Rnd() * 8 + 49))

S tímto mi to běhá cca 30ms, stejné jak na Win7 32 i 64bit
Já to jen trochu poupravil nijak jsem nezkoumal zda to psát i jinak.

--- Doplnění předchozího příspěvku (13 Led 2014 12:48) ---

to s tím časem mi nefunguje, tak jsem to musel dát pryč, mám Win 7 - 64 bit, ale zavedl jsem si tam já něco podobného.

Ta deklarace musí být v normálním modulu, ne listu.

To pomalejší je asi způsobeno tím, pokud to nemáš schválně, že vytváříš těch 200 7mimístných hesel 200x
Pokud je to správně tak mi to trvá 2,1s a pokud bych to provedl jen 1x tak 16ms.

[lubo.]

ale musel jsem upravit to násobení (za 26 dát 25 a za 9 dát , jinak to házelo i znaky ":" a "]". V excelu jako vzorce to fungovalo správně viz list1 ...

Chyba a překlep. Správně to má být:

Kód: Vybrat vše

         If Rnd() < 0.3 Then
            achar = Chr(Int(Rnd() * 26 + 65))
         Else
            achar = Chr(Int(Rnd() * 9 + 49))
         End If
         avysledek = avysledek & achar


Ne CInt ale jen Int.

To co máš v kódu pomalé, jsou selekty, nepotřebuješ je:

Kód: Vybrat vše

  Columns("E:F").ClearContents
  pocetznaku = Range("B1").Value
  pocethesel = Range("B2").Value
  pocetopakovani = Range("B3").Value
  Set kod = ActiveSheet.Range("D1:D" & pocethesel)
 
  t = Time()

  ReDim hesla(1 To pocethesel, 1 To 1)

For n = 0 To pocetopakovani - 1

  Columns("D:E").NumberFormat = "@"
   
  '-------------tvorba_hesla------------------------------
  For b = LBound(hesla, 1) To UBound(hesla, 1)
      avysledek = ""
      For a = 1 To pocetznaku
         If Rnd() < 0.3 Then
            achar = Chr(Int(Rnd() * 26 + 65))
         Else
            achar = Chr(Int(Rnd() * 9 + 49))
         End If
         avysledek = avysledek & achar
      Next a
      hesla(b, 1) = avysledek
   Next b
   kod.Value2 = hesla
   '-------------tvorba_hesla------------------------------
   
   '-------------řazení------------------------------
'   AbecedníSeřazeníPole hesla
   ActiveSheet.Range("E1:E" & pocethesel).Value2 = hesla

   With ActiveWorkbook.Worksheets("gen").Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("E1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Range("E1:E" & pocethesel)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
   End With
  '-------------řazení------------------------------
   p = p + 1
   Range("F1:F" & pocethesel).FormulaLocal = "=KDYŽ(E1=E2;1;0)"

   ' počet nalezených shod
   i = i + Range("B13").Value
Next n


Použití procedury to už moc nezrychlí. Pokud ji chceš použít, je třeba ji trochu upravit na 2 rozměry.