AW: Zufallsgenerator
ransi
HAllo
Um mal schnell ein par Beispieldaten in eine Tabelle zubekommen nutze ich seit geraumer Zeit das hier:
Das kommt dem Gewünschten schon recht nah....
Public Sub zahl()
Dim arr
Dim Z As Long
Dim S As Integer
Dim unten As Long
Dim oben As Long
Dim Bereich As Range
Dim i As Long
Dim K As Long
On Error GoTo schluss
Set Bereich = Application.InputBox(prompt:="Zellen markieren !" & Chr(13) & "Zahlen", Default:=Selection.Address, Type:=8)
If Bereich Is Nothing Then GoTo schluss
unten = Application.InputBox(prompt:="Untergrenze", Default:=0, Title:="Zufallsbereich", Type:=1)
oben = Application.InputBox(prompt:="Obergrenze", Default:=100, Title:="Zufallsbereich", Type:=1)
With Application 'zum beschleunigen
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Z = Bereich.Rows.Count
S = Bereich.Columns.Count
Redim arr(1 To Z, 1 To S)
Randomize
For i = 1 To Z
For K = 1 To S
arr(i, K) = Int((oben - unten + 1) * Rnd + unten)
Next
Next
Bereich.Value = arr
schluss:
With Application 'zum beschleunigen
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Set Bereich = Nothing
End Sub
Public Sub str()
Dim arr
Dim Z As Long
Dim S As Integer
Dim Bereich As Range
Dim i As Long
Dim K As Long
Dim w As Integer
Dim w1 As Integer
On Error GoTo schluss
Set Bereich = Application.InputBox(prompt:="Zellen markieren !" & Chr(13) & "Buchstaben", Type:=8, Default:=Selection.Address)
If Bereich Is Nothing Then GoTo schluss
w = Application.InputBox(prompt:="Zellen markieren !" & Chr(13) & "Wieviele Buchstaben", Type:=1, Default:=1)
With Application 'zum beschleunigen
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Z = Bereich.Rows.Count
S = Bereich.Columns.Count
Redim arr(1 To Z, 1 To S)
Randomize
For i = 1 To Z
For K = 1 To S
For w1 = 1 To w
arr(i, K) = arr(i, K) & IIf(Rnd <= 1 / 3, Chr(Int(10 * Rnd + 48)), Chr(Int(26 * Rnd + 65)))
Next
Next
Next
Bereich.Value = arr
schluss:
With Application 'zum beschleunigen
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Set Bereich = Nothing
End Sub
ransi