Option Explicit
Const c_Z_ERSTE = 2
Const c_Z_LETZTE = 21
Const c_ANZAHL_AUSZUWAEHLENDER_ZEILEN = 5
Sub ZeilenZufaelligAuswaehlen()
'*** Aus den definierten Zeile (von c_Z_ERSTE bis c_Z_LETZTE)
'*** werden per Zufallsgenerator
'*** c_ANZAHL_AUSZUWAEHLENDER_ZEILEN Zeilen ausgewaehlt und
'*** auf dem aktuellen Blatt selektiert
Dim f() As Long, x As Long
Dim r As Range, rGes As Range
If Not ZufallszahlenBestimmen(f(), c_Z_ERSTE, c_Z_LETZTE, c_ANZAHL_AUSZUWAEHLENDER_ZEILEN) Then GoTo AUFRAEUMEN
->Zeilen auf dem aktuellen Blatt selektieren
For x = LBound(f()) To UBound(f())
Set r = Range(f(x) & : & f(x))
If rGes Is Nothing Then Set rGes = r Else Set rGes = Union(rGes, r)
Next
rGes.Select
AUFRAEUMEN:
Set r = Nothing: Set rGes = Nothing
End Sub
Function ZufallszahlenBestimmen(f() As Long, lStart As Long, lEnde As Long, lAnz As Long) As Boolean
Dim x As Long, y As Long, lZufallszahl As Long, lNothalt As Long
Dim bNochNichtGemerkt As Boolean
->pruefen, ob Zufallszeilennummern bestimmbar sind
If lAnz >= (lEnde - lStart + 1) Then
MsgBox (Anzahl der auszusuchenden Zeilen >= Gesamt-Zeilenanzahl)
ZufallszahlenBestimmen = False
Exit Function
End If
ReDim f(1 To lAnz)
x = 0
lNothalt = 0
Do
->Alle Zufallszahlen bestimmt ?
If x = lAnz Then Exit Do
->Nothalt um ggf. Endlosschleife abzubrechen
lNothalt = lNothalt + 1
If lNothalt > 10000 Then
MsgBox (Nothalt in Zufallszahlenbestimmung hat zugeschlagen.)
ZufallszahlenBestimmen = False
Exit Do
End If
->naechste Zufallszeilenzahl bestimmen
->Int((Obergrenze - Untergrenze + 1) * Rnd + Untergrenze)
Randomize Timer
lZufallszahl = Int((lEnde - lStart + 1) * Rnd + lStart)
->pruefen , ob Zufallszeilenzahl bereits gemerkt ist
bNochNichtGemerkt = True
For y = 1 To x
If f(y) = lZufallszahl Then bNochNichtGemerkt = False: Exit For
Next
->Wenn Zufallszeilenzahl noch nicht gemerkt ist, merken
If bNochNichtGemerkt Then
x = x + 1
f(x) = lZufallszahl
End If
Loop
ZufallszahlenBestimmen = True
End Function
