Excel Makro Lotto 1-49 mit Bedienung

[Snuffx]

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.

Mit welchem Code sollte das hinzufügen?

[Peter K.]

Hallo Snuffx,


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.


Beste Grüße

Peter K.

.