Thema: Lotto 6 aus 45 - jede Zahl genau 2 Mal getippt

Liebes Forum,

ich habe gerade an einer Lösung für folgendes Problem gebastelt: Es sollen 15 Tipps (in Summe 90 Zahlen) für Lotto 6aus45 zufällig generiert werden, dabei soll jede Zahl genau 2 Mal verwendet werden. Die Lösung unten funktioniert für diesen Zweck soweit.
-> Nur wirklich schön/elegant ist sie selbst in meinen Augen etwas anderes
-> Vielleicht hat jemand Zeit dies auf Verbesserungspotential hin zu prüfen - fällt jemandem eine bessere Lösung ein? Vielleicht etwas das man auch nach oben hin dimensionieren könnte (z.B. genau 4 x/Zahl bei 180 Zahlen etc.)?

Private Sub Lotto()

Range("C3:Q47").ClearContents



Dim gezogen() As Boolean, x, y, z, arr(1 To 15, 1 To 6)

ReDim gezogen(1 To 45)

Randomize

For x = 1 To 7

    For y = 1 To 6

        Do

            z = Int(Rnd * 45) + 1

        Loop Until Not gezogen(z)

        gezogen(z) = True

        arr(x, y) = z

    Next y

Next x



y = 1

For x = 1 To 45

    If gezogen(x) = False Then

        arr(8, y) = x

        y = y + 1

    End If

Next x



ReDim gezogen(1 To 45)

For x = 1 To 3

    gezogen(arr(8, x)) = True

Next x



For x = 4 To 6

    Do

        z = Int(Rnd * 45) + 1

    Loop Until Not gezogen(z)

    gezogen(z) = True

    arr(8, x) = z

Next x



For x = 1 To 3

    gezogen(arr(8, x)) = False

Next x



For x = 9 To 15

    For y = 1 To 6

        Do

            z = Int(Rnd * 45) + 1

        Loop Until Not gezogen(z)

        gezogen(z) = True

        arr(x, y) = z

    Next y

Next x



For x = 1 To 15

    For y = 1 To 6

        Cells(arr(x, y) + 2, x + 2) = 1

    Next y

Next x



End Sub

Gruß Michael

Hi Michael,

nur n Tipp:
Anstelle von nur Code zu zeigen, zeig doch lieber per Upload eine Excel-Bsp-Datei mit Bsp-Daten und dem Code in der Datei.

Ciao
Thorsten

Wieso hast du meinen Code so verhunzt ? :)

Das ist wieder ein schönes Beispiel dafür, wie groß die Differenz zwischen dem
- was gedacht war..
- gesagt wurde..
- verstanden und schließlich..
- umgesetzt wurde..
sein kann.

Wie ein Kind im Cockpit einer 747: Drücken wir mal dieses Knöpfchen, dann Jenes, diesen Hebel mal hochziehen und mal sehen, was passiert.

Ich denke mal, dass du dann irgendwo speichern musst, wie oft eine Zahl bereits gezogen wurden.
Bei jedem ziehen müsstest du dann nicht nur prüfen, ob im aktuellen Tipp die Zahl schon vorhanden ist, sondern auch noch nicht zu häufig gezogen wurde.
Für mich sieht das nach Übungsaufgabe aus.
Sowas war z.B. in Java auch ganz beliebt..., nicht ganz so beliebt wie das Sieb des Eratosthenes

https://www.herber.de/bbs/user/169183.xlsm

Hallo

Da ich gerade langweile hatte, hier eine Alternative ohne VBA mit PQ
https://www.herber.de/bbs/user/169266.xlsx

....eigentlich ist die Ursprungsfrage schon längst beantwortet - aber ihr findet einfach kein Ende - und ich erhalte immer wieder und wieder Herber-Mails mit dem Hinweis, dass eine neue Antwort zu einem Beitrag vorhanden ist, auf den ich mal geantwortet habe....seuuufffzzzzzzzzz

und wenn euer! Thema "RND versa RandBetween" abgearbeitet ist, fangt ihr dann an darüber zu diskuttieren, dass orange eigtl die bessere Textfarbe ist als schwarz?????

(ich habe eine Premiere: noch nie habe ich mich bisher gefreut, wenn mal ein Beitrag im Archiv verschwindet und das Antworten - nicht mehr - möglich ist!)

Sorry, aber wieso nutzt du nicht einfach die Funktion "Benachrichtigungen zum Thread aufheben", wenn du nicht mehr interessiert bist?

cool, danke! ich wusste tatsächlich noch nicht, dass das Austragen auch bei einzelnen Beiträgen möglich ist; bin immer davon ausgegangen: "Benachrichtigung bei allen oder keinem Beitrag"

Auf die Art, hatte der Thread doch einen gewissen Wert :=))

Ob er aber dieses mal eine Mail bekommen hat, weiss man nicht.
Und? Hast du das Mysterium enträtseln können?

Du meinst dein doppeltes Bild?
Das erscheint mir, ehrlich gesagt, unglaublich.
Dass das auftritt, mag ja sein, aber dass du dann auch noch jeweils ein Bild davon hast.... Fake?

Mein Fehler - Ich hatte mit Randomize 1 (number) gespielt.
Obwohl MS schreibt "Mit Randomize mit demselben Wert für number wird die vorherige Folge nicht wiederholt.", wird alles nach 8 Durchgängen EXAKT wiederholt.

Teste mal bei dir.
Hier meine Daitei:
https://www.herber.de/bbs/user/169344.xlsb

Ja, das ist bei mir das Gleiche.
Ich hab jetzt auch noch mal geschaut, ob ich etwas darüber heraus finde, ob es einen Unterschied im Zufallsgenerator zwischen Rnd und Randbetween gibt.
Da bin ich keine Schritt weiter gekommen, denke aber nicht, dass zwischen rnd und Randbetween dahingehend ein Unterschied gibt.
Es scheint, dass in Excel ab 2010 als Zufallsgenerator Mersenne Twister (MT19937) verwendet wird. Das kommt aber alles nur aus Sekundärquellen.
Was, wenn ich es richtig verstehe, etwa 10^6000 mögliche Zustände bedeuten würde?
Das Problem bei rnd liegt eher darin, dass man sich mit irgendwelcher Anwendung von Randomize die angestrebte "Zufälligkeit" womöglich unbewusst zunichte macht...

Hallo

Jetzt mit der richtigen Datei.
https://www.herber.de/bbs/user/169269.xlsx

Hi

1. Erstelle ein Array mit 90 Einträgen, fülle das mit den Werten von 1 bis 45 2x

2. Laufe mit einer Schleife über das Array und tausche jede Position mit einer anderen zufällig ausgewählten Position des Arrays.
Damit hast du dann eine zufällige Durchmischung.

3. Weiße das einfach der Reihe nach zu:
Tipp 1: Pos 1-6
Tipp 2: Pos 7-12
...
Tipp 15: Pos 76-90

Gruß Daniel

Sehr elegante Lösung, eine minimale Verbesserung zu meiner Version ;). Nah, ich glaube viel besser geht nicht. Der Vergleich mit dem Kind das an vielen Hebeln zieht hat sicher was wahres - aber das ist am Ende auch die Natur von lernen. Ich habe nicht wirklich Programmiererfahrung - auf solche Lösungen kommt man schwer ohne. Aber dafür bin ich ja sehr dankbar für dieses Forum!

Bezüglich deines Codes wäre mir nur aufgefallen, dass eine Dimensionierung von arr(1 To 15, 1 To 6) denke ich im konkreten Fall genügt hätte (anstatt 1 To 100) (aber das macht am Ende in der Funktion ja nicht wirklich einen Unterschied.

Danke und Gruß, Michael

An arr habe ich mich nicht erst aufgehalten, das brauchst ja nur DU.

Moment, ich dachte, dass das die Lösung war, bei der theoretisch beim 8ten Tipp doppelte Zahlen vorkommen könnten
Hab ich da was übersehen ?

Also ich hab die Datei runter geladen...
und da kommt bei Tipp 8:
1 27 23 35 1 29
Wo ist denn die "funktionierende" Lösung.

mein "Werk"

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim u As Long, x As Long, y As Long, z As Long

    Dim arrOut(14, 5)

    Dim arrChk(1 To 45) As Long

    Dim rngOut As Range

    

    Set rngOut = Tabelle1.Range("A1").Resize(15, 6)

    rngOut.ClearContents

    

    Randomize

    

    For x = 1 To 15

        u = IIf(x < 8, 1, 2)

        Select Case x

            Case 1 To 7, 9 To 14

                For y = 1 To 6

                    Do

                        z = Int(Rnd * 45) + 1

                    Loop Until arrChk(z) < u

                    arrChk(z) = arrChk(z) + 1

                    arrOut(x - 1, y - 1) = z

                Next y

            Case 8

                'Die 3 letzen der ersten 45

                ReDim gezogen(1 To 45)

                y = 1

                For z = 1 To 45

                    If arrChk(z) < 1 Then

                        arrOut(x - 1, y - 1) = z

                        gezogen(z) = True

                        arrChk(z) = arrChk(z) + 1

                        y = y + 1

                    End If

                Next

                'plus 3 neue, ungleich der ersten 3

                For y = 4 To 6

                    Do

                        z = Int(Rnd * 45) + 1

                    Loop Until Not gezogen(z) And arrChk(z) < u

                    gezogen(z) = True

                    arrChk(z) = arrChk(z) + 1

                    arrOut(x - 1, y - 1) = z

                Next

            Case 15

                'was von den 2ten 45 übrig ist

                y = 1

                For z = 1 To 45

                    If arrChk(z) < 2 Then

'                        arrChk(z) = arrChk(z) + 1

                        arrOut(x - 1, y - 1) = z

                        y = y + 1

                    End If

                Next

        End Select

    Next x

    

    rngOut = arrOut



End Sub

Die ALLERERSTE ohne Swappen (14:23 Uhr).

Die ALLERERSTE ohne Swappen (12:23 Uhr).

Bei der passiert aber doch das Gleiche.
Ich hatte mir das mit dem swappen gar nicht angeschaut.
und wie es der Teufel will, ich drücke n paar mal auf das Knöpfchen und hab doppelte in Tipp 8

Da hast du recht - ist mir zuerst nicht aufgefallen. In den meisten Fällen passiert es natürlich nicht, aber in ca. jedem 15ten Fall kommt es bezüglich der letzten 3 Ziffern zu einer Überschneidung. Insofern löst der Code von Onur das Problem leider doch nicht.

... meinte natürlich bei ca. jedem 5. Mal ...

Ich mache ja bei meinem "Werk" fast das Gleiche, habe nur 2 Fälle abgetrennt
In Tipp 8 und 15 wird jeweils einfach der Rest der Ersten bzw. Zweiten 45 aufgebraucht.
Was soll ich da lange mit Random rum machen.
in Tipp 8 nehme ich ein zweites Array zu Hilfe, um sicher zu stellen, dass die 3 letzten Zahlen aus
den Ersten 45 durch 3 Zahlen der Zweiten 45 ohne Dopplung ergänzt werden.
Ist halt nicht ganz so kompakt und liese sich wahrscheinlich noch besser machen,
aber wichtig ist mir primär : make it run.

Korrigiert:
Siehe meine Antwort an Oppawinni.

Hast Recht. Das selbe Problem wie mit Swap.
Mit einer kleinen Änderung klappt es aber:
Die Änderung könnte man auch in die SWAP-Version einbauen.

https://www.herber.de/bbs/user/169198.xlsm

... es kommen noch immer doppelte Werte in Zeile 8 ...

War die falsche Version - Sorry!

https://www.herber.de/bbs/user/169199.xlsm

Hier mit bunten "Lämpchen" . :)
https://www.herber.de/bbs/user/169200.xlsm

Diese Version funktioniert jetzt sehr sauber. Aber in Punkto Laufzeit hat hier meine verhunzte Version die Nase deutlich vorn ;)

Dann mach doch mal das "DoEvents" im Code weg. ;)

Jetzt ist schön und schnell :)

Baue ich beim Herumtesten extra immer rein, da sonst (gerade bei solchen Loops) schnell mal der Rechner hängt und der ganze Code weg ist.

Dein Code lässt sich auch super nach oben dimensionieren - funktioniert bei kleinen Ergänzungen auch bei beispielsweise 90 Tipps mit jeder Zahl maximal 12 x ...

Dann musst du die Doppelte-Funktion auch anpassen. Die reagiert z.Z. nur auf Zele 7.

Meine Version gefällt dir wohl nicht ?
https://www.herber.de/forum/messages/1976276.html

Gut, ich tröste mich damit, dass ich die erste funktionierende Lösung gepostet habe, obwohl ich mir damit viel Zeit gelassen hatte, in der Annahme dass das Thema schnell erledigt wäre.....
und zudem die Lösung vermutlich aktuell noch die schnellste ist, weil ich nicht warte bis random die letzten 3 bzw. letzten 6 Zahlen auch noch gefunden hat...
Des Menschen Wille...

Vielleicht hätte ich auch meine Ursprungsversion posten sollen.
Ich hatte halt versucht diese doppelte Array-Prüfung auf ein Minimum zu reduzieren.
Die ist im Grunde nur im Übergang der Ersten 45 Zahlen zu den Zweiten 45 Zahlen notwendig.
Und dachte auch, dass es keinen Sinn macht, die jeweils letzten Zahlen per Random zu ermitteln,
da ohnehin nichts anderes mehr kommen kann, als diese letzten Zahlen.
Gut, sieht vielleicht mehr nach Zufall aus, wenn die Zahlen in der letzten Reihe nicht geordnet sind....
und der Code war halt kurz. Wie man's macht.

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim u As Long, x As Long, y As Long, z As Long

    Dim arrOut(14, 5)

    Dim arrChk(1 To 45) As Long

    Dim rngOut As Range

    

    Set rngOut = Tabelle1.Range("A1").Resize(15, 6)

    rngOut.ClearContents

    

    Randomize

    

    For x = 1 To 15

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            u = IIf((x - 1) * 6 + y > 45, 2, 1)

            Do

                z = Int(Rnd * 45) + 1

            Loop Until Not gezogen(z) And arrChk(z) < u

            gezogen(z) = True

            arrChk(z) = arrChk(z) + 1

            arrOut(x - 1, y - 1) = z

        Next y

    Next x

    

    rngOut = arrOut



End Sub

Hallo Oppawinnie,

habe mich jetzt auch noch im Detail mit deinen beiden Lösungen beschäftigt und konnte dabei viel lernen. Die Ursprungsvariante gefällt mir der Einfachheit dabei fast noch besser - vor allem der Ansatz "u = IIf((x - 1) * 6 + y > 45, 2, 1)". Danke, dass du dir die viele Arbeit gemacht hast! - Für mich ist das recht schwer soviel Info aus den vielen Antworten an einem Tag/Abend zu verarbeiten - speziell weil ich noch etwas länger brauche um den Code im Detail zu verstehen (und zwei Kinder daneben herumtanzen ;)). Es ist zwar gut, dass sich gleich mehrere Leute hier einer Frage annehmen, aber leider auch nicht ganz leicht auf alles gleich zu reagieren (und ich tu nicht gern so als ob ich mir etwas angesehen hätte, wenn ich das nicht wirklich habe). Vielleicht sollte man ins Forum eine "Pause"-Funktion einbauen ;) - "... bitte vorerst nicht weiter antworten, ich denke noch über die letzte Lösung nach ..." Insofern vielen Dank auch dir - die Laufzeit ist hier definitiv sehr "instant" und ohne Ruckeln. Der Zufall ist gegeben, die Bedingung erfüllt. - Auch eine sehr schöne Lösung. Wegen der Skalierbarkeit werde ich mir jetzt noch Gedanken machen - aber hier würde ich erst eine Frage stellen wenn ich nicht mehr weiterkomme (ohne Übung kommt man nicht weiter)

Vielen Dank! Michael

Das war jetzt wirklich keine "Arbeit".
Vielleicht dennoch, um das nachzuvollziehen:

Die Ursprungslösung der Ursprungslösung war letztlich nur die Lösung für 15 Lottotipps (wie sie z.B. Onur auch etwa vorgeschlagen hatte).
Da hab ich halt noch ein zusätzliches Array zur Prüfung rein gemacht um eben genau 2 mal die 45 Zahlen abzusichern.
Kein großer Aufwand.

Also nochmal Ur-Ur-Lösung:

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim u As Long, x As Long, y As Long, z As Long

    Dim arrOut(14, 5)

    Dim rngOut As Range

    

    Set rngOut = Tabelle1.Range("A1").Resize(15, 6)

    rngOut.ClearContents

    

    Randomize

    

    For x = 1 To 15

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            Do

                z = Int(Rnd * 45) + 1

            Loop Until Not gezogen(z)

            gezogen(z) = True

            arrOut(x - 1, y - 1) = z

        Next y

    Next x

    

    rngOut = arrOut



End Sub

Lies das halt, wenn du wieder Zeit hast... Der Thread ist ja nicht ewig offen.

Ich hatte noch eine andere Lösung, die ...
wollte ich eigentlich nicht vorschlagen, weil...
je mehr Zahlen, desto länger dauert es, bis jede Zahl getroffen ist.
Aber prinzipiell hat das auch was ....
Es erzwingt nicht, dass in der ersten sieben Tipps jede Zahl nur einmal vorkommen darf.

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim zugverbraucht() As Boolean

    Dim u As Long, x As Long, y As Long, z As Long

    Dim arrOut(14, 5)

    Dim rngOut As Range

    

    Set rngOut = Tabelle1.Range("A1").Resize(15, 6)

    rngOut.ClearContents

    

    Randomize

    

    ReDim zugverbraucht(1 To 90)

    

    For x = 1 To 15

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            Do

                u = Int(Rnd * 90) + 1

                z = (u - 1) Mod 45 + 1

            Loop Until Not gezogen(z) And Not zugverbraucht(u)

            gezogen(z) = True

            zugverbraucht(u) = True

            arrOut(x - 1, y - 1) = z

        Next y

    Next x

    

    rngOut = arrOut



End Sub

Mir ist gerade wieder eingefallen, dass da das Problem auftreten kann,
dass beim letzten Tipp keine 6 verschiedenen mehr übrig sind und dann ist es gut, wenn man ein DoEvents eingebaut hat, sonst hängt sich das Ding auf.

Hi
hier mal ein Lösungsansatz, der immer Funktionierten sollte.

Prinzip:
man erstellt zuerst zwei getrennte Reihen, die man zufällig durchmischt
dann macht man eine Sonderziehung und nimmt die Zahlen dieser Sonderziehung aus den anderen beiden Reihen heraus (3 Zahlen aus Reihe 1, drei Zahlen aus Reihe 2, so dass keine Dopplungen entstehen.

Sub Lotto_6aus45_jedeZahl2x()

Dim i As Long, j As Long, k As Long, r As Long

Dim x

Dim Kugeln(1 To 45)

Dim Reihen(1 To 3)



Dim Ergebnis(1 To 15, 1 To 6)





For r = 1 To 3

    For k = 1 To 45

        Kugeln(k) = Format(k, " 00")

    Next





    For i = 1 To 45

        j = WorksheetFunction.RandBetween(1, 45)

        x = Kugeln(i)

        Kugeln(i) = Kugeln(j)

        Kugeln(j) = x

    Next

    

    Reihen(r) = Kugeln

Next



For i = 1 To 3

    k = Application.Match(Reihen(2)(i), Reihen(1), 0)

    Reihen(1)(k) = ""

Next

For i = 4 To 6

    k = Application.Match(Reihen(2)(i), Reihen(3), 0)

    Reihen(3)(k) = ""

Next



For i = 7 To 45

    Reihen(2)(i) = ""

Next



x = ""

For r = 1 To 3

    x = x & Join(Reihen(r), "")

Next

x = Split(x, " ")

k = 0

For i = 1 To 15

    For j = 1 To 6

        k = k + 1

        Ergebnis(i, j) = CLng(x(k))

    Next

Next



Cells(2, 1).Resize(15, 6) = Ergebnis



End Sub

Gruß Daniel

Man könnte das zweite Array aber schon auch mit Boolean machen....
Damit hätte man jetzt jede Zahl genau 6 mal.

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim zugverbraucht() As Boolean

    Dim ziehungen As Long, x As Long, y As Long, z As Long

    Dim arrOut() As Variant

    Dim rngOut As Range

    

    ziehungen = 45

    Set rngOut = Tabelle1.Range("A1").Resize(ziehungen, 6)

    rngOut.ClearContents

    

    ReDim arrOut(ziehungen, 5)

    

    Randomize

        

    For x = 1 To ziehungen

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            If ((x - 1) * 6 + y) Mod 45 = 1 Then

                ReDim zugverbraucht(1 To 45)

            End If

            Do

                z = Int(Rnd * 45) + 1

                DoEvents

            Loop Until Not gezogen(z) And Not zugverbraucht(z)

            gezogen(z) = True

            zugverbraucht(z) = True

            arrOut(x - 1, y - 1) = z

        Next y

    Next x

    

    rngOut = arrOut



End Sub

Ich weiß ja nicht, warum du so gerne Arrays mischt, aber eine "immer funktionierende" Lösungen gibt es ja schon.
Freilich könnte man z.B. auch ein zwei-D Array nehmen, das aber jeweils nur 42 Zahlen aufnehmen kann, also z.B. arr(41,1)
würfelt dann einmal 6 verschiedene Zahlen aus 45, wovon jeweils 3 nicht in das Array geschrieben werden.
Diese ersten Zahlen 6 Zahlen wären der erste Tipp...
Dann kannst du meinetwegen das Array mischen, oder halt zufällig daraus ziehen. musst aber halt auch erst die ersten 42 und
dann die zweiten 42 nehmen...
also unter dem Strich seh ich da nichts neues.

Mit Mischen bekommt man ein Ziehen ohne Zurücklegen, ohne das man extra prüfen muss, ob der Zufallswert bereits gezogen wurde.
Es gibt hier kein "wiederhole solange, bis die Werte passen".

dein letztes Makro benötigt für die 90 Ziehungen so zwischen 300-600 Zufallswerte.
meines kommt mit konstant 135 aus.

Klar, man braucht da schon viele Zufallszahlen.
Insbesondere bei der letzten Kombi wären die dann auch noch völlig überflüssig, aber naja.
Ist halt ne sehr kompakte Lösung und ob das mit der Mischerei dann schneller ist, will ich nicht testen.
Und wenn... für die 2 oder 4 Tipps würd ich den Rechner nicht bemühen.

ob schneller, kommt darauf an.
nehmen wir mal an, das geht nicht von 1-45 sondern von 1-1000000 und du willst alle Werte einmal zufällig ziehen, dann könnte es länger dauern, bis du "zufällig" den passenden Wert bekommst.
oder du musst das ganze so programmieren, dass du den gezogenen Wert aus der Gesamtmenge entfernst, und das ist in VBA mit einfachen Arrays etwas aufwendig, da es hier kein .RemoveItem gibt und man dann "von Hand" alle Werte ab dem gezogenen um einen Platz nach vorne versetzen muss. (ein Grund, warum das ganze teilweise über Texte, bzw Join und Split lösen.)

In Excel selbst könnt man das Mischen mit einer einfachen Formel lösen (Zufallszahl zuweisen und dann Sortieren), das wäre ein sehr einfacher Weg, zumindest ab Excel 365.

Gruß Daniel

Ich werde ja nie so viele Lotto-Tipps brauchen, damit die ganzen Posts hier rechnen :)

aber für dich hab ich jetzt mal einfach die letzten Zahlen nicht mehr per Random ermitteln lassen.
(Tipp 8 die ersten 3, Tipp 15 komplett)
Es ist ja klar, dass, je weniger Zahlen noch da sind, desto länger braucht Random bis es die findet.
Macht aber auch wirklich nicht viel Sinn, die von Random suchen zu lassen.

Die optimierte Fassung meiner ersten geposteten Lösung
Damit bin ich jetzt bei etwa 200 Zufallszahlen für die 15 Tipps, variiert halt, logisch.

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim n As Long, x As Long, y As Long, z As Long, k As Long

    Dim arrOut(14, 5)

    Dim verbraucht() As Boolean

    Dim rngOut As Range

    

    Set rngOut = Tabelle1.Range("A1").Resize(15, 6)

    rngOut.ClearContents

    

    Randomize

    

    For x = 1 To 15

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            n = n + 1

            If n Mod 45 = 1 Then

                ReDim verbraucht(1 To 45)

            End If

            If (n Mod 45 > 39) And (n Mod 6 = 1) Then

                Debug.Print n,

                For z = 1 To 45

                    If Not verbraucht(z) Then

                        arrOut(x - 1, y - 1) = z

                        y = y + 1

                        n = n + 1

                        gezogen(z) = True

                    End If

                Next

                n = n - 1

                y = y - 1

            Else

                Do

                    z = Int(Rnd * 45) + 1

                    k = k + 1

                Loop Until Not gezogen(z) And Not verbraucht(z)

                gezogen(z) = True

                verbraucht(z) = True

                arrOut(x - 1, y - 1) = z

            End If

        Next

    Next x

    

    Debug.Print k

    

    rngOut = arrOut



End Sub

Jetzt wird halt wieder komplizierter mit unterschiedlichen Systemen.

Da finde ich das Mischen doch deutlich einfacher und methodisch konsequenter.

Warum magst du das Mischen nicht, welche bedenken hast du?

Da ist nichts kompliziertes
und ich schieße nicht mit Kanonen auf Spatzen.

Ich hab mal deinen und meinen Code je 10000 mal ausführen lassen (natürlich ohne Debug.print)
Das gibt noch ein Argument weniger für deinen Code.... teste selbst.

Wirst du soviele Tipps jemals verwenden? ;-)

Zeig mal deine Testdstatei, bzw welche Makros hast für den konkret verwendet?
Es gibt hier mittlerweile so viele Varianten des Makros und wir sollten schon die gleiche Basis haben und Äpfel mit Äpfeln vergleichen.

Das Problem ist doch, dass du mit einem Durchlauf keine sinnvolle Zeitmessung machen kannst.
Ich brauche überhaupt nie einen Lottotipp, ich hab einen, den ich ab und an spiele, aber es das immer der Gleiche.
Ich dachte von Anfang an, dass das eine Übungsaufgabe ist, weil das kein Mensch braucht, aber egal.
Teste was du willst.
Du kommst mit deiner Mischerei ohnehin nicht ran.

Ran an was?

Warum stellst du nicht einfach deine Testdatei zur Verfügung?
Dann hätten wir die selbe Basis.

"teste was du willst"

Nein will ich nicht. Ich will testen, was du getestet hast. Alles andere macht keinen Sinn.

Sorry, keine Ahnung, da muss mir gestern ein Windows-Prozess eine Streich gespielt haben.
Gestern schien deine Version fast 3 mal so lange zu brauchen.
Heute ist sie im Vorteil. Versteh ich auch nicht mehr.
Also dann ist doch nicht so schlecht, wie ich erwartet hatte...
Array Elemente tauschen sollte auch nicht gerade das schnellste sein... man wird doch immer mal wieder überrascht.

jetzt hab ich mal nur in einem Fall
z = int(rnd * 45)+1
durch
z = worksheetfunction.randbetween(1,45)
ersetzt
und die Laufzeit hat sich mehr als verdoppelt.....
VBA muss man auch nicht immer verstehen, oder?
So, mir reicht es jetzt aber wirklich mit der Würfelei und Mischerei.

Ja, wenn man 2 Methoden miteinander vergleichen will, dann muss man schauen, dass in den Testmakros nur genau dieser Bereich unterschiedlich ist und alles andere gleich ist, sonst vergleicht man Äpfel mit Birnen und nicht zwei Äpfel. Wenn du also prüfen willst, ob "Mischen" besser ist als "solang Zufallszahlen ziehen bis die passende dabei ist", solltest du in beiden Fällen auch die selbe Methode zum Ermitteln der Zufallszahlen verwenden.

Beim RND wir nicht zufällig eine Zahl ermittelt, sondern es ist einfach eine Tabelle mit fest vorgegebenen Zahlen hinterlegt, die nacheinander ausgegeben werden.( Daher bekommt man auch die selben Zahlen, wenn man den selben Einstiegspunkt in die Tabelle wählt. )
Deswegen ist das schnell, weil einfach nur ein Wert aus einer Tabelle gelesen werden muss.

Beim Worksheefunction.RandBetween geht es nicht so einfach. Zum einen ist das keine originäre VBA-Funktion, sondern eine Excelfunktion, zum anderen kennt Excel auch kein Randomize und die Werte müssen auch noch variabel in den Wertebereich umgerechnet werden. Was genau bei RandBetween passiert kann ich dir auch nicht sagen, aber es ist auf jeden Fall aufwendiger als das RND.

Und beim Arbeiten mit einfachen WerteArrays ist VBA sehr schnell. Da kann man problemlos viele Aktionen durchführen.
Auch das Rausnehmen der 6 Werte der ersten Ziehung könnte man noch optimieren, in dem man die Werte rausnimmt, bevor man die Liste sortiert, dann müsste man nicht suchen, sondern könnte einfach auf die Position gehen.
Ich hab das hier nur mit der Suche gemacht, damit ich alle drei Kugelreihen in einer Schleife erstellen und Mischen kann.

Vom Rechenaufwand her wäre es vielleicht sogar am besten , wenn man beide Methoden mischt und die erste Ziehung nach der Zufallszahlen mit Prüfung durchführt, da hier noch wenige Wiederholungen zu erwarten sind und auch die Menge der bereits gezogenen Zahlen, die ja immer durchsucht werden muss noch klein ist, und den Rest dann nach dem Mischprinzip, welches ohne Wiederholungen und Prüfungen auskommt.

Gruß Daniel

Ja, du hast Recht, man muss schon schauen.. und da war doch der Wurm.
Ich hab ja immer vorne nen Range deklariert... und den dann benutzt, um
- vorne den Ausgabebereich zu leeren
- hinten dann das Ergebnis raus zu werfen.
Wenn ich das gerade ziehe, indem ich grundsätzlich den Range nicht deklariere, sondern am Ende nur Tabelle1.Range("A1").offset( )... = blabla mache..
dann sah das Testergebnis nach 10000 aufrufen so aus:

4,25s -lottoShuffle
21,44922s -Lotto_6aus45_jedeZahl2x
4,644531s -Lotto
Das erste Ergebnis ist eine Variante, die ich noch nicht gepostet habe, ohne join, split oder match, aber immerhin mit Mischen.
Das zweite ist das was du gepostet hattest, wobei da eben worksheetfunction.RandBetween(1,45) drinnen war.
Das dritte war dann meine Variante, die ich 03.05.2024 22:54:24 gepostet hatte, aber, wie gesagt ohne dieses DIM rngOut und rngOut.ClearContents
Das entspricht wieder etwa den Verhältnissen, die ich von gestern Abend im Kopf hatte....

Ich hab dann mal bei deinem Teil das randBetween durch Rnd ersetzt und ein randomize ergänzt. Dann sah es so aus:
4,625s -lottoShuffle
8,171875s -Lotto_6aus45_jedeZahl2x
4,523438s -Lotto

Das passt jetzt schon wieder besser in mein Weltbild, wobei das Mischen da auch nicht sooo schlecht weg kommt.
So richtig ideal ist der Test wahrscheinlich so auch nicht.... Zeigt aber zumindest, wie aufwändig RandBetween ist.
Jetzt komm bloß nicht auf die blöde Idee noch irgendwas zu testen........ : =))

Jetzt komm bloß nicht auf die blöde Idee noch irgendwas zu testen........ : =))

Warum denn? Solche Tests sind ein guter Weg, um Verstehen zu lernen wie das ganze funktioniert und was schnell ist und was nicht.

Außerdem hast du mich neugierig gemacht, zeigmal dein neues Makro.

von mir aus. Ich bin davon nicht begeistert.
Im Prinzip hatte ich das aber schon beschrieben...

Sub lottoShuffle()

    Dim arrOut(14, 5) As Variant

    Dim arrNumbers(1 To 42) As Integer

    Dim gezogen(1 To 45) As Boolean

    Dim u As Long, i As Long, j As Long, k As Long, x As Long, y As Long, z As Long

    Dim v As Variant

    

    Randomize

        

    x = 0

    For y = 1 To 6

        Do

            z = Int(Rnd * 45) + 1

        Loop Until Not gezogen(z)

        gezogen(z) = True

        arrOut(x, y - 1) = z

    Next

    

    x = 1: y = 0

    For i = 1 To 2

        k = 1: u = 1

        For j = 1 To 45

           If Not gezogen(j) Or u > 3 Then

              arrNumbers(k) = j

              k = k + 1

           Else

              gezogen(j) = False

              u = u + 1

           End If

        Next

                

        shuffleArray arrNumbers

        

        For Each v In arrNumbers

            arrOut(x, y) = v

            y = y + 1

            If y > 5 Then y = 0: x = x + 1

        Next

    Next

       

    Tabelle1.Range("A1").Resize(15, 6) = arrOut

    

End Sub



Sub shuffleArray(ByRef arrIn As Variant)

    'shuffle nach Fisher-Yates

    Dim lngLower As Long

    Dim lngUpper As Long

    Dim i As Long, z As Long

    Dim vField As Variant

    

    Randomize

    

    lngUpper = UBound(arrIn)

    lngLower = LBound(arrIn)

    

    For i = lngUpper To lngLower + 1 Step -1

        z = Int(Rnd * i) + lngLower

        vField = arrIn(i)

        arrIn(i) = arrIn(z)

        arrIn(z) = vField

    Next

End Sub

Gerade bemerkt, ich mal wieder schlampig unterwegs...
Fehler bei der Berechnung des Zufallszahlenbereichs
da ...

Sub shuffleArray(ByRef arrIn As Variant)

  ...        

z = Int(Rnd * (i - lngLower + 1)) + lngLower

...

End Sub

Ich habe jetzt meine Testprozedur nochmal verändert.
Und zwar habe ich 100 mal jede Variante 10000 mal aufrufen lassen, wobei die Reihenfolge der Varianten zufällig wechselte.
Die Ausgabe der Resultate im Worksheet, die bei 10000 Aufrufen in Summe 3.5 bis 3.8 Sekunden brauchte, hab ich dann auch noch auskommentiert.
Als Ergebnis hier die Mittelwerte und die Standardabweichung zu je 10000 Aufrufen:

mit RND:

LottoShuffle                           Mean:  0,315s StddDev.:  0,021s

Lotto_6aus45_jedeZahl2x                Mean:  3,744s StddDev.:  0,104s

Lotto                                  Mean:  0,327s StddDev.:  0,022s

mit RandBetween:

LottoShuffle                           Mean:  8,751s StddDev.:  0,325s

Lotto_6aus45_jedeZahl2x                Mean: 16,714s StddDev.:  0,363s

Lotto                                  Mean: 19,596s StddDev.:  0,311s

Während sich bei Verwendung von RND die Ergebnisse von "Lotto" und "LottoShuffle" wenig unterscheiden,
schlägt bei Verwendung von RandBeetween die Zahl der Aufrufe der Zufallsfunktion erbarmungslos zu Buche.
"Lotto" fällt dann sogar deutlich hinter "Lotto_6aus45_jedeZahl2x" zurück.
Warum die Varianz bei "Lotto_6aus45_jedeZahl2x" immer die größte ist, dafür hab ich keine Erklärung,
vielleicht wegen Match ?
(StddDev, sprich Standardabweichung ist die Wurzel aus der Varianz)
_________________
Unter dem Strich würde ich raten RandBeetween in VBA zu meiden, insb. wenn Performance wichtig ist.
Wenn man es nicht vermeiden kann oder will, dann tut man gut daran es so sparsam wie möglich einsetzen.
Ich könnte mir denken, dass bei Verwendung von RND, wenn man das auf einen großen Zahlenbereich ausdehnt,
dass da dann prinzipbedingt gewisse Lücken in den Zufallszahlen entstehen könnten.
Andererseits soll, wenn ich es recht habe, die VBA-Implementation von RND eine Liste ca. (2^27) Pseudozufallszahlen sein.
Da müsste man wahrscheinlich schon sehr weit dehnen. Dann wäre die Frage, wo die Grenze etwa liegt.
Vielleicht kann jemand erklären, in welchen Fällen RandBeetween vorgezogen werden sollte/muss.

Was heisst "10000 Aufrufen " ?
10000 Zahlen ziehen oder 10000 Reihen ziehen? Mit oder ohne Ausgabe auf Blatt?

Das Thema ist nicht ganz so einfach wie es erscheint.
Geschwindigkeit ist das Eine, Zufall das Andere...
Von daher wollte ich doch irgendwie den den Vorteil von RandBetween sehen, wenn es denn einen gibt.
Ich hab also mal folgendes Programm laufen lassen:

Sub test()

    Dim i As Long, z() As Long

    Randomize

    

    ReDim z(9999, 3)

    For i = 0 To 9999

    '    Randomize

        z(i, 0) = WorksheetFunction.RandBetween(0, 100)

        z(i, 1) = WorksheetFunction.RandBetween(0, 100)

        z(i, 2) = Int(Rnd * 101)

        z(i, 3) = Int(Rnd * 101)

    Next

    Range("A1").Resize(1000, 4) = z



End Sub

das liefert dann 4 Spalten mit Zahlen zwischen 0 und 100, wovon die Ersten beiden mit RandBetween
und die zweiten mit RND erzeugt sind.
Betrachtet man das jeweils als X Y Werte, ergibt das etwa solche Diagramme


So weit sieht das doch ganz ähnlich aus, aber...
Es könnte aber ja jemand denken, dass ein weiteres Randomize nicht schaden könnte und setzt in die Schleife noch ein Randomize hinein.
(Ich hab das im Code auskommentiert)

Das Ergebnis sieht dann aber etwa so aus:


sowas will man nicht wirklich... und ich hatte das so auch nicht erwartet.
Man könnte sagen, Randomize ist gut, aber zu viel des Guten ist ungesund.
Das Problem hat man halt bei Randbetween nicht.

Poste doch mal deine Datei.

"Das Thema ist nicht ganz so einfach wie es erscheint. " - Es wird sogar noch komplierter !

Das obere Bild und das untere Bild sind 8-9 Button-Klicks voneinander entfernt:

Hallo

Randomize verwendet die Timer() Funktion zum setzten des Start Wertes. Da diese Funktion 1/100 Sekunden liefert, deine Schleife aber viel schneller ist wird die RND Funktion immer wieder auf den selben Wert zurückgesetzt und Du bekommst die gleichen Zahlen.

Peter

Das ist Quatsch! Randomize wird nur mit Timer gefüttert, wenn kein Parameter angegeben wird.
Microsoft: "Mit Randomize mit demselben Wert für number wird die vorherige Folge nicht wiederholt."
Wenn man "Randomize 3" nimmt, passiert das Selbe.

Hallo

Opawinni hat Randomize ohne Parameter aufgerufen!

Peter

Also mit dem selben WERT (nämlich Timer) !

Also mit dem selben WERT (nämlich Timer) !
Abgesehen davon: timer ist nicht auf 1/100 sek genau.
Timer ist ein SINGLE- Wert und der geht " 1,401298E-45 bis 3,4028235E+38 ".

naja, jede der drei Varianten produziert bei einem Aufruf die 15 tipps, wobei jede zahl 2 mal vorkommt.
Dass ich für die 10000 Aufrufe den Output in das Worksheet auskommentiert hatte, hab ich aber geschrieben.
Ok, ist schon ein wenig lang geworden, der Thread.
Was ist der Hintergrund deiner Frage ?

Mach doch mal stattdessen 1x 150.000 Tipp-Reihen. Wäre "realitätsnaher", da niemand 10.000 x das Makro starten würde.
Bin mal gespannt.

Hier mal die drei Varianten, damit du nicht suchen musst und wir ggf. über das Gleiche reden:
Hab alle auf RND eingestellt.

Sub Lotto()

    

    Dim gezogen() As Boolean

    Dim n As Long, x As Long, y As Long, z As Long, k As Long

    Dim arrOut(14, 5)

    Dim verbraucht() As Boolean

       

    Randomize

    

    For x = 1 To 15

        ReDim gezogen(1 To 45)

        For y = 1 To 6

            n = n + 1

            If n Mod 45 = 1 Then

                ReDim verbraucht(1 To 45)

            End If

            If (n Mod 45 > 39) And (n Mod 6 = 1) Then

                For z = 1 To 45

                    If Not verbraucht(z) Then

                        arrOut(x - 1, y - 1) = z

                        y = y + 1

                        n = n + 1

                        gezogen(z) = True

                    End If

                Next

                n = n - 1

                y = y - 1

            Else

                Do

'                    z = WorksheetFunction.RandBetween(1, 45)

                    z = Int(Rnd * 45) + 1

                    k = k + 1

                Loop Until Not gezogen(z) And Not verbraucht(z)

                gezogen(z) = True

                verbraucht(z) = True

                arrOut(x - 1, y - 1) = z

            End If

        Next

    Next x

       

    Tabelle1.Range("A1").Resize(15, 6) = arrOut



End Sub





Sub LottoShuffle()

    Dim arrOut(14, 5) As Variant

    Dim arrNumbers(1 To 42) As Integer

    Dim gezogen(1 To 45) As Boolean

    Dim u As Long, i As Long, j As Long, k As Long, x As Long, y As Long, z As Long

    Dim v As Variant

    

    Randomize

        

    x = 0

    For y = 1 To 6

        Do

'            z = WorksheetFunction.RandBetween(1, 45)

            z = Int(Rnd * 45) + 1

        Loop Until Not gezogen(z)

        gezogen(z) = True

        arrOut(x, y - 1) = z

    Next

    

    x = 1: y = 0

    For i = 1 To 2

        k = 1: u = 1

        For j = 1 To 45

           If Not gezogen(j) Or u > 3 Then

              arrNumbers(k) = j

              k = k + 1

           Else

              gezogen(j) = False

              u = u + 1

           End If

        Next

                

        ShuffleArray arrNumbers

        

        For Each v In arrNumbers

            arrOut(x, y) = v

            y = y + 1

            If y > 5 Then y = 0: x = x + 1

        Next

    Next

       

    Tabelle1.Range("A1").Resize(15, 6) = arrOut

    

End Sub



Sub ShuffleArray(ByRef arrIn As Variant)

    'shuffle nach Fisher-Yates

    Dim lngLower As Long

    Dim lngUpper As Long

    Dim i As Long, z As Long

    Dim vField As Variant

    

    Randomize

    

    lngUpper = UBound(arrIn)

    lngLower = LBound(arrIn)

    

    For i = lngUpper To lngLower + 1 Step -1

        z = Int(Rnd * (i - lngLower + 1)) + lngLower

'        z = WorksheetFunction.RandBetween(lngLower, i)

        vField = arrIn(i)

        arrIn(i) = arrIn(z)

        arrIn(z) = vField

    Next

End Sub



Sub Lotto_6aus45_jedeZahl2x()

    'daniel bei herber.de

    Dim i As Long, j As Long, k As Long, r As Long

    Dim x

    Dim Kugeln(1 To 45) As Variant

    Dim Reihen(1 To 3) As Variant

    

    Dim Ergebnis(1 To 15, 1 To 6)

    Randomize

    

    For r = 1 To 3

        For k = 1 To 45

            Kugeln(k) = Format(k, " 00")

        Next

        

        For i = 1 To 45

'            j = WorksheetFunction.RandBetween(1, 45)

            j = Int(Rnd * 45) + 1

            x = Kugeln(i)

            Kugeln(i) = Kugeln(j)

            Kugeln(j) = x

        Next

        

        Reihen(r) = Kugeln

    Next

    

    For i = 1 To 3

        k = WorksheetFunction.Match(Reihen(2)(i), Reihen(1), 0)

        Reihen(1)(k) = ""

    Next

    

    For i = 4 To 6

        k = WorksheetFunction.Match(Reihen(2)(i), Reihen(3), 0)

        Reihen(3)(k) = ""

    Next

    

    For i = 7 To 45

        

        Reihen(2)(i) = ""

    Next

    

    x = ""

    For r = 1 To 3

        x = x & Join(Reihen(r), "")

    Next

    x = Split(x, " ")

    k = 0

    For i = 1 To 15

        For j = 1 To 6

            k = k + 1

            Ergebnis(i, j) = CLng(x(k))

        Next

    Next



    Tabelle1.Range("A1").Resize(15, 6) = Ergebnis



End Sub

"shuffle nach Fisher-Yates" ???
Noch nie was von ihm gehört, aber habe den selben Algorithmus auch schon vor Jahrzehnten selbst geschrieben. Ist ja auch logisch, wenn man etwas überlegt, kommt man von selbst auf diese Idee. Ähnlich wie mit "Quicksort" oder "Bubblesort" - es gibt halt nicht viele Möglichkeiten, effektiv und schnell Zahlen zu sortieren oder zu vermischen und man kommt unweigerlich selber auf diese Ideen. :)
Hier ist meine Datei:
https://www.herber.de/bbs/user/169274.xlsm

Ja, Onur, das ist bei vielen Erfindungen so, im Prinzip war logisch, dass man dort hin kommt, aber es gab halt einen, der für sich reklamiert, dass er zuerst dort hin gekommen ist... und Fisher-Yates war halt 1938, da waren wir chancenlos.
Dein Lotto auf Basis von Strings ist ne gute Idee, lesefreundlicher Code ist halt anders :)
String hat zumindest den Vorteil gegen Array, dass man da kein Redim braucht, wenn man mehr oder weniger drinn haben will.
Die 150000 Tipps hätte es IMHO jetzt nicht gebraucht und den Algo zu demonstrieren.
Im Grunde kannst du doch jede Version auf das X-fache aufblasen, wenn man da ne Schleife drum macht und den Output jeweils um die 15 Zeilen versetzt.

" und Fisher-Yates war halt 1938, da waren wir chancenlos. " - Tja, aber jeder Hütchenspieler macht im Prinzip das Selbe (wenn auch nur mit 3 Zahlen), und die gibt es schon seit Urzeiten. :)

Der Artikel
https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle
ist übrigens sehr interessant

Da heisst es u.a. etwa, dass:
selbst wenn die Anzahl der möglichen Zustände eines Zufallsgenarators die Anzahl der Permutationen übersteigt, die unregelmäßige Natur der Zuordnung von Zahlenfolgen zu Permutationen dazu führt, dass einige Permutationen häufiger auftreten als andere. Um Verzerrungen zu minimieren, sollte daher die Anzahl der Zustände des Zufallsgenerators die Anzahl der Permutationen um mindestens mehrere Größenordnungen übersteigen...

Bei 45 Zahlen gibt es aber immerhin schon etwa 1,2 × 10^56 mögliche Permutation.
Nachdem die VBA-Implementation von RND meines Wissens auf 2^27, also etwa 1,3 * 10^8 Pseudozufallszahlen beruht, wird da wohl nicht jede Permutation gleich oft kommen.
Wobei es dann aber wieder ein Stück weit wurscht sein dürfte, ob 1,2,3,4,5,6 oder 6,5,4,3,2,1 gezogen wird. Es gibt bei 6 aus 45 z.B. laut "Österreichische Lotterien" nur 8145060 verschiedene Tipps...

Man darf aber halt beim Mischen von mehr als etwa 11 Zahlen schon nicht mehr auf ein gleichmäßiges Auftreten aller möglichen Permutation hoffen... wenn ich das richtig verstehe..
Keine Ahnung, Wie viel tauglicher RandBetween in dieser Hinsicht wäre.

Zu deiner Variante
Ich hab die dann auch mal in meinen Test einbezogen (mit RND, ohne Output).
Ich hab das natürlich auf 15 Reihen beschränkt und "LottoStringShuffle" genannt.

Ergebnis:

-lottoShuffle                           Mean:  0,336s StddDev.:  0,048s

-Lotto_6aus45_jedeZahl2x                Mean:  5,611s StddDev.:  0,228s

-Lotto                                  Mean:  0,336s StddDev.:  0,040s

-LottoStringShuffle                     Mean:  2,066s StddDev.:  0,122s

Dein Rechner scheint um einiges schneller zu sein, als meiner, wobei meiner heute dazu auch noch n bissl träge war.
Wenn ich dein Sheet aufrufe und den Knopf drücke, bin ich leicht mit 3,5 Sekunden unterwegs.

"Bei 45 Zahlen gibt es aber immerhin schon etwa 1,2 × 10^56 mögliche Permutation. Nachdem die VBA-Implementation von RND meines Wissens auf 2^27, also etwa 1,3 * 10^8 Pseudozufallszahlen beruht, wird da wohl nicht jede Permutation gleich oft kommen. " - Eigentlich sind wir ja anscheinend irgend wie "gestört". Warum sonst würden wir diskutieren, wie man ein Problem am Besten löst, den es wohl in der Praxis nie geben wird? 15 Reihen Lotto 6 aus 45, aber jede Zahl muss genau 2 mal vorkommen? WOZU ???

Das haben halt Übungsaufgaben so an sich, dass das jetzt nicht unbedingt ein direkten praktischen Bezug hat.
Aber klar, es erscheint irgendwie widersinnig, zufällige Tipps haben zu wollen, die dann aber doch irgendwie wieder einzuschränken.
Der Zufall in der Zwangsjacke.
Wäre vllt. interessant zu wissen, wie viele Möglichkeiten es da gäbe.
Du könntest ja vielleicht mal prüfen, inwieweit es bei deinen 150000 Tipps schon Wiederholungen gibt und ggf. wie viele.
Lass dir ruhig Zeit :=))

Es gibt übrigens "nur" 6,09278E+63 Möglichkeiten für die 15 Ziehungen.
Das ist wesentlich weniger als die Möglichkeiten für 15 normale (voneinander unabhängige) Ziehungen mit 4,607E+103 Möglichkeiten, was wiederum wesentlich höher wäre als die Zahl der Atome im Universum mit "zwischen 10 hoch 84 und 10 hoch 89".
Die Chance, 15 Wochen hintereinander 6 Richtige bei "6 aus 45" zu haben, ist also 4,607E+103 - Schade eigentlich......

DAS sind die Durchschnitt-Ergebnisse der 3 Makros bei mir:
0,9629 sec/10.000 Durchläufe
0,9258 sec/10.000 Durchläufe
2,2383 sec/10.000 Durchläufe

Nee du, ich bin jetzt durch damit.
Es wäre dann ja auch wieder das Problem, dass ich da viel am Code herum machen muss.
Das wollte ich aber gerade möglichst vermeiden (außer was testbedingt nötig war).
Du kannst das aber auch gerne Testen, wenn du Lust drauf hast. Ich nehme an, dass du das so gut kannst, wie ich.
Je nach Variante dauert das halt. Du hast ja gelesen.
Bei dem einen Test ca. 45 sec für 10000 Aufrufe aller 3 Varianten und das 100 mal, lief also fast 1,5 Stunden.
(Zwischen den 10000er Tests wird ja Statistik gemacht DoEvents, neu gewürfelt in welcher Reihenfolge die Tests als nächstes ausgeführt werden und sowas alles..)

"45 sec für 10000 Aufrufe aller 3 Varianten" ? Habe ich was falsch verstanden?
0,315 + 3,744 + 0,327 sind bei mir 4,386 Sekunden.

Hab es gesehen - alle 6 Tests statt 3.
Mir würde der schnellste reichen.

Also das Innere von LottoShuffle mit RND und ohne Output in einer Schleife von 1 bis 1000000 dauerte in EINEM Testlauf (Der Statistiker sagt, eine Messung ist keine Messung), wäre hätte es gedacht 32,74 s, also etwa wie 100 * die 10000 Aufrufe, die im Schnitt 0,315 s brauchten.
Das hab ich gemacht. Wenn du was anderes willst...
15 Mio. Lottotipps braucht übrigens auch niemand. Es ging doch nur darum, dass man an einem Durchlauf nicht sinnvoll etwas messen kann.

Meine neue Version ist beliebig erweiterbar (Anzahl der Tipps nicht auf 15 beschränkt) und braucht ca 1,15 sec für 150.000 Reihen....

Wo ist deine neue Version und wie schnell das auf deinem Rechner ist, sagt jetzt nicht viel.
Hast du einen Vergleich mit einer der von mir getesteten Versionen?

gute Idee.
Vielleicht hilft da dann:
https://de.wikipedia.org/wiki/Zuf%C3%A4llige_Permutation#Fisher-Yates-Verfahren

Finde ich einen guten Ansatz. Es kann dann allerdings passieren, dass zufällig zwei gleiche Zahlen zueinander geordnet werden. Das darf beim Lotto natürlich nicht sein. Deshalb folgende Variante:

Man benötigt nur ein Array mit 45 Elementen. Die Indizes sind die erste Zahl, weil sowieso alle Zahlen einmal vorkommen müssen. (Lässt man das Array 0-Basiert, muss halt +1 gerechnet werden bei der Auswertung).

Schritt 2. von Daniel (Array mit 1 bis 45 füllen und züfällig umsortieren)

Paarungen prüfen. Bei Zahlengleichheit mit dem rechten Element tauschen

Paarungen sind nun eindeutig durch Index und Element gegeben

Das Forum hat einen Fehler beim Absenden geworfen. Konnte durch den Zurück-Button im Browser bis in den Editiermodus zurück. Habe dann aber geschaut, ob der Beitrag doch gespeichert wurde. Ja, wurde er, nur an der falschen Stelle.

Warum versuchen eigentlich immer noch alle, ein längst (von mir) gelöstes Problem zu lösen?
Und das auch noch mit theoretischen Ratschlägen, ohne irgend einen konkreten Code zu posten.

Weil viele Wege nach Rom führen und eine Diskussion auf sachlicher Ebene für andere vielleicht erhellender ist, als für Dich.

Anders ausgedrückt:
Du bist pragmatisch und siehst das Problem als gelöst an, sobald es eine Lösung gibt.
Jemand wie ich sieht zwar, dass es bereits eine Lösung gibt, aber im Kopf rattert es eben, weiter.

äh, Moooment,
Du lässt aus 45 Zahlen so lange Zahlen ziehen, bis keine mehr da sind, dann stellst du 45 neue bereit, richtig ?
Du prüfst auch nur, ob die gezogene Zahl noch eine von den bereitgestellten ist... also...
Nachdem aber 45 nicht ganzzahlig durch 6 teilbar ist, könnte mit einer gewissen Wahrscheinlichkeit bei dem einen Tipp,
der im Übergang liegt zwischen alte aufgebraucht/neue bereitgestellt doppelte Zahlen vorkommen....oder irre ich mich.

Siehe mein Beitrag von 16:33 Uhr.

Das so ein Chaos hier, heute.... ich hab deine erste Lösung verpasst.
Ich hätte halt einfach zwei Arrays gemacht und doppelt geprüft.... Aber schöne Irrwege sind auch schön.

Nur dass viele der "Vorschläge" doch das Selbe sind, was ich längst angewendet habe. Daher der Verdacht, dass sich keiner meine Lösung überhaupt angeschaut hat.
Und: Wenn irgend Jemand einen Alternativcode gepostet hätte, hätte ich ja auch nix gesagt.

Ok,

da gebe ich Dir recht. In der Tat habe ich Deine Lösung erst nach meinem Posting angeschaut ;-) Aber ich habe sie angeschaut.

Da Du gerne eine andere Lösung auch in Code sehen möchtest, habe ich nun auch eine Umsetzung meines Vorschlages auf Basis von Daniels Vorschlag gemacht. Da ich ein fauler Entwickler bin, habe ich mich auf die Suche nach einer fertigen Lösung für das Durchwürfeln des Arrays begeben. Dabei bin ich auf die Klasse BetterArray gestoßen. Finde ich echt super und habe die genutzt. Die bringt nämlich einen Shuffle mit ;-)
Ausführliche Doku zur Klasse BetterArray: https://senipah.github.io/VBA-Better-Array/api/
BetterArray auf GitHub: https://github.com/Senipah/VBA-Better-Array?tab=readme-ov-file

Die Klasse muss ins Projekt importiert werden, dann läuft das folgende Makro. Die Laufzeit ist gut:

Sub getPairs()



  Dim pairs As BetterArray  ' Array der Klasse BetterArray vorbereiten

  Dim i As Byte             ' Schleifenzähler

  Dim temp As Byte          ' Hilfsvariable zum Tausch eines Platzes im Array

  Dim check As Boolean      ' Solange es gleiche Paare gibt, weiter prüfen und tauschen

  

  Set pairs = New BetterArray ' Array vom Datentyp Better Array bereit stellen

  

  ' Array initialisieren

  For i = 0 To 45

    pairs.Push i

  Next i

  

  ' Array Elemente dureinader würfeln

  pairs.Shuffle

  

  ' Gleiche Paare verhindern

  ' Solange, bis sicher ist, dass es keine mehr gibt

  Do

    ' Zunächst letztes Paar auslassen, weil es bei

    ' Gleichheit kein Folgepaar gibt

    For i = 1 To 44

      If i = pairs(i) Then

        temp = pairs(i)

        pairs(i) = pairs(i + 1)

        pairs(i + 1) = temp

      End If

    Next i

    ' Paar 45 vergleichen

    ' Bei Gleichheit mit Paar 1 tauschen

    If pairs(45) = 45 Then

      temp = pairs(45)

      pairs(45) = pairs(1)

      pairs(1) = temp

    Else

      check = True

    End If

  Loop Until check

  

  ' Zahlenpaare ausgeben

  For i = 1 To 45

    ActiveSheet.Cells(i, 1) = i

    ActiveSheet.Cells(i, 2) = pairs(i)

  Next i

End Sub

Die Sub könnte auch in eine Funktion überführt werden, die die Grenzen für die zu bildenden Paare als Parameter übernimmt. Denn ein Vorteil von BetterArray ist, es ist eine dynamische Datenstruktur.

Hier noch die lauffähige Datei dazu:
https://www.herber.de/bbs/user/169191.xlsm

Wenn man 100x Zahlenpaare swappt, sollte es reichen:
https://www.herber.de/bbs/user/169192.xlsm

Mea culpa

Ich habe die "Aufgabenstellung" mal wieder nur halb gelesen :-/ Hatte mich beim ersten Anblick Deiner Ausgabe noch gewundert, warum Du so einen "massiven" Zahlenblock ausgibst. Das sind natürlich die geforderten Tippreihen mit jeweils 6 Zahlen. Ich war voll auf Zahlenpaare fokussiert. In der Tat gibt mein Algorithmus das Ergebnis nicht her, denn innerhalb drei aufeinanderfolgender Paarungen (sechs Zahlen) können doppelte vorkommen.

Ich ziehe trotzdem ein positives Fazit:
Du hast die Laufzeit Deines Makros drastisch erhöht
Auch wenn Du die Problemstellung mit Bordmitteln super gelöst hast, habe ich BetterArray für mich entdeckt

Auch wegen meiner Erkenntnis finde ich weiterführende Diskussionen gut. Ich habe etwas gelernt. Deshalb bin ich hier :-)

Danke^^

Ein Problem meines zweiten Codes (eben erst eingefallen): Bei der achten Kolonne könnten Doppelte vorkommen, da die Zahlen in 45er Blöcken gemischt werden.
Die Lösung dieses Problemes wäre aber zu kompliziert und der erste Code von mir läuft ja schon problemlos..... :)

Das kann ich jetzt so schnell nicht nachvollziehen. Du steckst in Deinem Code, ich in meinem. Da ist mir eingefallen, ich brauche die Do-Until-Schleife gar nicht. Wenn das letzte Zahlenpaar 45 45 lautet, sind alle Paare auf jeden Fall ungleich, wenn 45 mit 1 getauscht wird.

Nee, es wird im Bereich 1 bis 45 geswappt und im Bereich 46 bis 90.
Im Bereich 43 bis 45 könnten Zahlen vorkommen, die auch im Bereich 46 bis 48 sind.

Genau, beim SWAPPEN reicht eine normale Schleife. Ob die Zahlenpaare gleich sind, spielt keine Rolle, wenn man nur oft genug swappt.

Nur dass dann 2 mal die gleiche Zahl in einer Reihe kommen kann .....

Och, jetzt wollt ich sehen, wie einer Array-Shuffle kreiert und dann merkt, dass das ne schöne Übung war.