RegistrierungUser-MapMitgliederlisteAdministratoren und ModeratorenSucheHäufig gestellte FragenHangmanSpieleZum PortalZur Startseite
+++ Das Lotto-Toto Info Forum mit diversen Tippgemeinschaften in allen Bereichen!! Mitspiel ab 18 Jahre!!!! +++
Lotto-Totostrategen.de » Lotto » Lotto und VBA für Excel » Excel Makro Lotto 1-49 mit Bedienung » Hallo Gast [anmelden|registrieren]
Druckvorschau | An Freund senden | Thema zu Favoriten hinzufügen
Neues Thema erstellen Antwort erstellen
Autor
Beitrag « Vorheriges Thema | Nächstes Thema »
Snuffx
Jungspund


Dabei seit: 02 Feb, 2017
Beiträge: 21

Excel Makro Lotto 1-49 mit Bedienung Zitatantwort auf diesen Beitrag erstellen Diesen Beitrag editieren/löschen Diesen Beitrag einem Moderator melden       IP Information Zum Anfang der Seite springen

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?

25 Jan, 2018 13:47 09 Snuffx ist offline Email an Snuffx senden Beiträge von Snuffx suchen Nehmen Sie Snuffx in Ihre Freundesliste auf
Peter K. Peter K. ist männlich
Moderator


Dabei seit: 06 Dec, 2009
Beiträge: 6505

Vollsystem-Generator Zitatantwort auf diesen Beitrag erstellen Diesen Beitrag editieren/löschen Diesen Beitrag einem Moderator melden       IP Information Zum Anfang der Seite springen

Hallo Snuffx, wink


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.

.

25 Jan, 2018 18:15 35 Peter K. ist offline Email an Peter K. senden Beiträge von Peter K. suchen Nehmen Sie Peter K. in Ihre Freundesliste auf
 
Neues Thema erstellen Antwort erstellen
Gehe zu:
Lotto-Totostrategen.de » Lotto » Lotto und VBA für Excel » Excel Makro Lotto 1-49 mit Bedienung » Hallo Gast [anmelden|registrieren]

radiosunlight.de Geblockte Angriffe: 32366 | prof. Blocks: 24 | Spy-/Malware: 113
CT Security System lite v3.0.4: © 2006 Frank John & cback.de
Impressum | Datenschutzerklärung Impressum Kostenloser Suchmaschineneintrag
|

Powered by Burning Board Lite 1.0.2 © 2001-2007 WoltLab GmbH