AW: Zufallszahl
22.04.2005 14:03:07
ANdreas
Hallo Christoph,
hier eine reine VBA-Lösung ohne Krücken und ohne ewigen Vergleich ob gezogene schon mal gezogen und dadurch evtl. nie terminiert:
Private Sub SetZufallszahlen(ByRef varParam() As Integer, ByVal intUnter%, ByVal intOber%)
' Funktion erhält 3 Parameter
' 1. Array in welches in die Zufallszahlen geschrieben werden,
' Anzahl wird durch Dimension des Array bestimmt
' 2. Untergrenze Zahlenbereich
' 3. Obergrenze Zahlenbereich
Dim intAnzahl%, intZahlen%, intZufall%, i%
Dim arrZufall() As Integer
' Anzahl zu ermittelnder Zahlen
intAnzahl = UBound(varParam) + 1 ' beginnt mit 0
' Anzahl unterschiedlicher Zahlen
intZahlen = intOber - intUnter
' Abbruch wenn Untergrenze>Obergrenze oder Zahlenvorrat zu klein
If intZahlen < 1 Or intZahlen < intAnzahl Then Exit Sub
Randomize ' Zufallsgenerator initialisieren
' Array mit allen Zahlen zw. Untergrenze und Obergrenze
ReDim arrZufall(intZahlen)
' Array füllen
For i = intUnter To intOber
arrZufall(i - intUnter) = i
Next i
' Zufallszahlen ziehen und aus arrZufall auslesen
' Gezogene Zahl in ParameterArray schreiben
' Gezogene Zahl korrekt aus arrZufall entfernen (keine Zahl kann 2x gezogen werden)
For i = 1 To intAnzahl
intZufall = Int((intZahlen - i + 2) * Rnd)
varParam(i - 1) = arrZufall(intZufall)
arrZufall(intZufall) = arrZufall(UBound(arrZufall))
ReDim Preserve arrZufall(UBound(arrZufall) - 1)
Next i
End Sub
Sub TestZufall()
Dim varArray() As Integer
Dim intAnzahlWerte%, s$, i%
intAnzahlWerte = 10 ' Anzahl zu ermittelnder Zufallszahlen
ReDim varArray(intAnzahlWerte - 1) ' Array für die Zufallszahlen
SetZufallszahlen varArray, 1, 20 ' Array, Untergrenze, Obergrenze
' Ausgabe der Werte
For i = 0 To intAnzahlWerte - 1
s = s & varArray(i) & vbCrLf
Next i
MsgBox s
End Sub
Gruß
Andreas