AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel
13.01.2016 16:24:57
Kolja
Ja, nur so fange ich keine doppelten ab. Und es geht mir tatsächlich um eine komplette liste.
Aber ich habe gerade die Lösung gefunden, wobei die die Anzahl auf 5 Stellen erhöht habe da ich sonst zu wenige Ergbnisse bekommen hätte... Es ist eine Modifikation eines Scripts aus dem oben stehenden Thread:
Sub Zahlen10()
Dim t As Double
Dim MyAr()
Dim a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer, B As Long, i _
As Integer, x As Integer
Dim check As Boolean
ReDim MyAr(1 To 99999)
Columns(10).ClearContents
Columns(10).NumberFormat = "00000"
For a1 = 0 To 5
For a2 = 0 To 5
For a3 = 0 To 5
For a4 = 0 To 5
For a5 = 0 To 5
If a1 a2 Then
If a2 a3 Then
If a3 a4 Then
If a4 a5 Then
i = i + 1: MyAr(i) = a1 * 10000# + a2 * 1000 + a3 * 100 + a4 * 10 + a5
End If
End If
End If
End If
Next a5
Next a4
Next a3
Next a2
Next a1
ReDim Preserve MyAr(1 To i)
Cells(1, 10).Value = t
Cells(2, 10).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub