Das Makro listet 1-49, was über 13 Mio Kombination aufgelistet,
code:
Sub Lotto_moegliche_Kombinationen()
Dim i As Byte, j As Byte, k As Byte, l As Byte, m As Byte, n As Byte
Dim c As Integer, r As Long
r = 1
c = 1
Application.ScreenUpdating = False
For i = 1 To 44
For j = i + 1 To 45
For k = j + 1 To 46
For l = k + 1 To 47
For m = l + 1 To 48
For n = m + 1 To 49
Cells(r, c) = i & " " & j & " " & k & " " & l & " " & m & " " & n
r = r + 1
If r > 65536 Then
Application.ScreenUpdating = True
c = c + 1
r = 1
ThisWorkbook.Save
If c > 256 Then
c = 1
Worksheets.Add
End If
Application.ScreenUpdating = False
End If
Next
Next
Next
Next
Next
Next
End Sub
Und das sollte mit einer Bedingung dazwischen aufgelistet
Die Zahlen, das Makro nicht listen sollte, sagen wir (1 2 3 4 und 47 48 49 oder 13 und 3 und 5)
Bedeutet „1 2 3 4 X X und X X X 47 48 49 oder 13 X und 3 X und 5 X „ werden nicht mitgezählt bzw eingetragen.
um ehrlich zu sein, ich verstehe den Sinn für Deinen Kürzungswunsch nicht.
Der gezeigte Code stellt ja einen Vollsystemgenerator mit allen 49 Zahlen dar.
Üblicherweise wird ein solches Vollsystem zum Vergleich mit einem Kürzungssystem gebraucht.
Um z.B. die Gewinntabellen zu erstellen.
Wenn das Vollsystem nun selbst gekürzt werden soll,
um möglicherweise selbst ein gekürztes System zu erstellen,
wird es mit den Kürzungsbedingungen (im Code) sehr schnell unübersichtlich.
Bei kleineren Vollsystemen macht die Kürzung erst recht keinen Sinn,
weil ja ein Platzhaltersystem erzeugt wird und die
Kürzungsbedingungen (alle Vierlinge) bei der Wahlzahlenzuweisung
nicht mehr zutreffend sind.
Da ich aber nicht weiß, was Du mit Deinem Anliegen vor hast,
hier also ein (mit heißer Nadel gestrickter) Lösungsversuch.
Als geforderte Bedingung habe ich die Eliminierung aller Vierlinge im Vollsystem genommen.
Um das Testsystem überschaubar zu halten,
habe ich das kleinere 12er-Vollsystem mit 924 Reihen genommen :
code:
Sub Lotto_moegliche_Kombinationen()
Dim i As Byte, j As Byte, k As Byte, l As Byte, m As Byte, n As Byte
Dim c As Integer, r As Long
r = 7
c = 1
Application.ScreenUpdating = False
For i = 1 To 7
For j = i + 1 To 8
For k = j + 1 To 9
For l = k + 1 To 10
For m = l + 1 To 11
For n = m + 1 To 12
If (j = i + 1 And k = i + 2 And l = i + 3) Then
GoTo Ohne_Speichern
ElseIf (k = j + 1 And l = j + 2 And m = j + 3) Then
GoTo Ohne_Speichern
ElseIf (l = k + 1 And m = k + 2 And n = k + 3) Then
GoTo Ohne_Speichern
End If
Cells(r, c) = i & " " & j & " " & k & " " & l & " " & m & " " & n
Ohne_Speichern: r = r + 1
If r > 231 Then
Application.ScreenUpdating = True
c = c + 1
r = 7
ThisWorkbook.Save
If c > 231 Then
c = 1
Worksheets.Add
End If
Application.ScreenUpdating = False
End If
Next
Next
Next
Next
Next
Next
End Sub
Ich hoffe, Du kannst das für Deine Zwecke gebrauchen.