Private Sub CommandButton1_Click()
Dim a As Integer
a = Sheets("Tabelle1").Range("E9").Value
Dim zufall() As String
ReDim zufall(1 To a) As String
Dim zaehler As Integer
zaehler = 2
Dim zaehler_arr As Long
zaehler_arr = 1
Dim intRow As Integer
For intRow = 1 To Range("E1")
Dim r As Range, zufallszelle As Integer, zufallsbereich As Integer
Set r = Range("B2:B3000").SpecialCells(xlCellTypeConstants)
zufallsbereich = Int(Rnd() * r.Areas.Count) + 1
Sprungziel: zufallszelle = Int(Rnd() * r.Areas(zufallsbereich).Cells.Count) + 1
zufall(zaehler_arr) = zufallszelle
zaehler_arr = zaehler_arr + 1
Dim j As Long, found As Boolean
For j = 1 To UBound(zufall)
If zufall(j) = zufallszelle Then
found = True
End If
Exit For
Next j
If found = True Then
GoTo Sprungziel
Else
r.Areas(zufallsbereich).Cells(zufallszelle).Activate
r.Areas(zufallsbereich).Cells(zufallszelle).Interior.ColorIndex = 4
Sheets("Tabelle1").Range("G" & zaehler).Value = r.Areas(zufallsbereich).Cells(zufallszelle)
zaehler = zaehler + 1
End If
Next intRow
Range("E1").Select
End Sub