|
Hallo
so?
Option Explicit
Sub Zahlen()
Dim Arr, Arr2, Neu, Weg As Integer, i As Integer, LR As Integer
'Sonderzeichen werden benötigt, da 2x 9
Arr = Array(1, 3, 5, 7, "9|", "9#", 4)
Weg = Int(Rnd * 3) 'Zufallszahl von 0-3 Also für die ersten 4 Einträge
Arr = Filter(Arr, Arr(Weg), False) ' Einen aus den 1 - 4ten Eintrag löschen
Do
'reset
Neu = ""
Arr2 = Arr
For i = 1 To 6
Weg = Int(Rnd * (UBound(Arr2) + 1))
'Neu zufällig zusammensetzen
Neu = Neu & "," & Arr2(Weg)
' den Fund löschen
Arr2 = Filter(Arr2, Arr2(Weg), False)
Next
'Sonderzeichen raus
Neu = Replace(Neu, "|", "")
Neu = Replace(Neu, "#", "")
'Solange, bis 2x 9, aber nicht hintereinander
Loop Until InStr(Neu, "9,9") = 0 And Len(Neu) - Len(Replace(Neu, "9", "")) = 2
'erstes Komma weg
Neu = Mid(Neu, 2)
LR = Cells(Rows.Count, "A").End(xlUp).Row
Cells(LR + 1, 1) = Neu
End Sub
LG UweD
|