určitě těch možností je víc. Nenabízí ale tolik možností, jako makro. Dodělal jsem to generování datumů, příp. by bylo možné řešit i čas.
Do makra jsem přidal nějaké implicitní hodnoty, které se nabízejí v jednotlivých inputboxech a předdefinoval několik seznamů, aby se nemusely vždy ručně vkládat (tato možnost je tam ale zachovaná). Datum se dá generovat v libovolném formátu a buď jako číslo nebo jako text. Dalo by se to dále rozvíjet a příp. dodělat tak, aby bylo možné nadefinovat libovolné varianty o více sloupcích např. do txt souboru a makrem najednou vygenerovat libovolný počet sloupců a řádků = celou požadovanou tabulku. Takto se generuje vždy pouze jeden sloupec pod aktivní buňku, je tedy makro nutné volat opakovaně a měnit pozici aktivní buňky. Pokud je makru přiřazená klávesová zkratka, jde to pouštět relativně rychle za sebou.Většímu rozšíření možností generování v tomto případě asi brání "ukecanost" dotazů, lepší by bylo to udělat přes formulář, takhle na to ale stačí cca 80 řádků textu. Je pravda, že nejsou ošetřené chybové stavy, ale pro účel generování náhodných pracovních dat to asi postačuje.
Option VBASupport 1
Sub Generuj_Data
Dim PocetGenerovanychHodnot As Integer
Dim c_Min, c_Max as Double
Dim Zaokrouhlit, textt, d_format, Textove as String
ReDim seznam_textu()
Dim mn(8)
mn(1) = "leden,únor,březen,duben,květen,červen,červenec,srpen,září,říjen,listopad,prosinec"
mn(2) = "jaro,léto,podzim,zima"
mn(3) = "Apple,LG,Nokia,Samsung,Sony"
mn(4) = "žena,muž,ostatní"
mn(5) = "Adamec,Kopecký,Novák,Novotný,Nový,Šťastný"
mn(6) = "hokej,fotbal,atletika,házená,biatlon,kuželky,šipky"
mn(7) = ""
mn(8) = ""
nabidka = "1 - " & mid(mn(1), 1, 12) & " " & "2 - " & mid(mn(2), 1, 12) & " " & "3 - " & mid(mn(3), 1, 12) & " " & "4 - " & mid(mn(4), 1, 12) & vbCrLf _
& "5 - " & mid(mn(5), 1, 12) & " " & "6 - " & mid(mn(6), 1, 12) & " " & "7 - " & mid(mn(7), 1, 12) & " " & "8 - " & mid(mn(8), 1, 12)
TypDat = InputBox("Vyber typ generovaných dat : " & vbCrLf _
&"" & vbCrLf _
&" 1 => Čísla 2 => Text 3 => Datum" & vbCrLf _
&" " & vbCrLf)
radek = ActiveCell.Row
sloupec = ActiveCell.Column
Application.ScreenUpdating = False
Select Case TypDat
Case Is = 1
PocetGenerovanychHodnot = InputBox("Zadej počet generovaných řádků : ")
c_Min = InputBox("Zadej minimální hodnotu čísla : ",,0)
c_Max = InputBox("Zadej maximální hodnotu čísla : ",,500)
Zaokrouhlit = Inputbox("Zaokrouhlit na celá čísla (A/N)? : ",,"N")
MsgBox "Vygeneruji " & PocetGenerovanychHodnot & " řádků s čísly od " & c_Min & " do " & c_Max
For i = 1 To PocetGenerovanychHodnot
NahodneCislo = (c_Max - c_Min) * Rnd() + c_Min
if Zaokrouhlit = "A" then NahodneCislo = round(NahodneCislo)
ActiveSheet.Cells(radek + i, sloupec) = NahodneCislo
Next i
Case Is = 2
PocetGenerovanychHodnot = InputBox("Zadej počet generovaných řádků : ")
textt = InputBox("Zadej vlastní seznam slov oddělených čárkou nebo číslo seznamu níže : " & vbCrLf _
&nabidka )
if len(textt) = 1 then
volba = textt
textt = mn(volba)
end if
MsgBox "Vygeneruji " & PocetGenerovanychHodnot & " řádků textů z množiny ("& textt &") "
j = len(textt) - len(replace(textt, ",", ""))
ReDim seznam_textu(j)
for k = 0 to j-1
hodnota = mid(textt, 1, instr(1, textt, ",")-1)
seznam_textu(k) = hodnota
hodnota = hodnota & ","
textt = replace(textt, hodnota, "")
Next k
seznam_textu(j) = textt
For i = 1 To PocetGenerovanychHodnot
NahodneCislo = int ((j + 1) * Rnd())
ActiveSheet.Cells(radek + i, sloupec) = seznam_textu(NahodneCislo)
Next i
Case Is = 3
PocetGenerovanychHodnot = InputBox("Zadej počet generovaných řádků : ")
d_Min = InputBox("Zadej datum od : ",,format(now()-100, "D.M.YYYY"))
d_Max = InputBox("Zadej datum do : ",,format(now(), "D.M.YYYY"))
d_format = Inputbox("Zadej generovaný formát datumu (masku) : ",,"D.M.YYYY")
Textove = Inputbox("Vygenerovat jako číslo nebo text (C/T)? : ",,"C")
date_min = datevalue(d_Min)
date_max = datevalue(d_Max)
MsgBox "Vygeneruji " & PocetGenerovanychHodnot & " řádků s datumy od " & d_Min & " do " & d_Max
For i = 1 To PocetGenerovanychHodnot
NahodneDatum = (date_max - date_min) * Rnd() + date_min
if Textove = "T" then
ActiveSheet.Cells(radek + i, sloupec) = Format(nahodnedatum,d_format)
else
ActiveSheet.Cells(radek + i, sloupec) = NahodneDatum
ActiveSheet.Cells(radek + i, sloupec).NumberFormat = d_format
end if
Next i
End Select
Application.ScreenUpdating = True
End Sub