Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1096to1100
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Lotto VBA autom. 6x6 aus Superlauf

Lotto VBA autom. 6x6 aus Superlauf
dieter(drummer)
Excel/VBA SoLaLa
Hi VBA Profis,
suche folgendes VBA Makro: Im Hintergrund sollen 6 Zufallszahlen (ganze Zahlen), inkl. 1 bis inkl. 49, immer wieder neu ermittelt werden bis mit ESC der Lauf gestoppt wird.
Nach Stop sollen die LETZTEN 6 ermittelten Zahlen ind 6 x 6 Zellen eingefügt werden. Das bedeutet, dass z.B in den Zellen A1 bis A6 6 Zahlen stehen und in B1 bis B6 andere 6 Zahlen usw bis E1 bis E6.
Dann sollen die am häufigsten vorkommenden 6 Zahlen, die in dem SUPERLAUF erzeugt wurden, in den Zellen A10 bis A15 eingefügt werden.
Ist das machbar oder geht mir hier der "Wunschgaul" durch?
Danke für's drum kümmern, Info und/oder evtl. VBA Lösung
Gruss dieter(drummer)

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Lotto VBA autom. 6x6 aus Superlauf
01.09.2009 13:28:22
JogyB
Hi.
Ist prinzipiell möglich... wie sollen denn Doubletten gehandhabt werden? Theoretisch könnten ja die letzten 6 Zahlen alle z.B. die 42 sein. Oder soll jede 6er Gruppe ein "6 aus 49" darstellen?
Gruss, Jogy
AW: Lotto VBA autom. 6x6 aus Superlauf
01.09.2009 13:35:31
dieter(drummer)
Hi Jogy,
Danke für schnelles drum kümmern. Es sollen KEINE DUBLETTEN inerhalb von 6 Zahlen vorkommen. Natürlich können in den anderen 6 x 6 Kombis gleich Zahlen vorkommen. Am Ende habe ich dann aber die häufigsten Zahlen von 1 bis 6, die im Supperlauf vorkamen.
Hoffe ich habe es richtig erklärt.
Gruß
dieter(drummer)
Mit Formeln und Iteration
01.09.2009 14:44:51
{Boris}
Hi Dieter,
das ist eine klasse Anwednung für die Iteration.
Anleitung:
1)
Extras-Optionen-Berechnen - Iteration aktivieren mit max. Iterationszahl: 1
2)
I1:N49: =ZUFALLSZAHL()
3)
A1: =VERGLEICH(KKLEINSTE(I$1:I$49;ZEILEN($1:1));I$1:I$49;)
und bis F6 kopieren
4)
P1:P49: Die Zahlen von 1 bis 49 aufsteigend eintragen
5)
Q1: =WENN(H$1="";0;Q1+ZÄHLENWENN(C$1:F$6;P1))+ZEILE()/100000000
und bis Q49 kopieren
6)
A10: =VERGLEICH(KGRÖSSTE(Q:Q;ZEILEN($1:1));Q:Q;)
und bis A15 kopieren
7)
B10: =KÜRZEN(SVERWEIS(A10;P:Q;2;))
und bis B15 kopieren
8)
In H1 (das ist die Steuerzelle) irgendeinen Wert eintragen (z.B. x) und dann mal F9 gedrückt halten.
Wenn Du den Eintrag in H1 wieder löschst, dann wird alles wieder auf 0 gesetzt. Trag in H1 wieder was ein, und es geht von vorne los.
Grüße Boris
Anzeige
AW: Danke Boris, werde testen
01.09.2009 14:54:50
dieter(drummer)
Danke Boris,
werde es in Excel eingeben und testen. Gebe dann Rückmeldung, die aber etwas dauern kann.
Gruss dieter(drummer)
AW: Danke Boris!
01.09.2009 15:13:13
dieter(drummer)
Hi Boris,
Dank für Deine Hilfe und Vorschlag. Werde mit Makro von NoNet und JogyB weiter arbeiten.
Trotzdem noch herzlichen Dank für den Vorschlag.
Gruß aus NRW
dieter(drummer)
Lotto 6 aus 49 - mehrere Ziehungen
01.09.2009 14:53:40
NoNet
Hallo Dieter,
(fast) nichts ist unmöglich - auch ohne "Wunschgaul" :
Option Explicit
Sub Lotto6aus49OhneDupletten()
'01.09.2009, NoNet - www.excelei.de
Dim intZahlen(1 To 49) As Integer, dblMisch(1 To 49) As Double
Dim intGezogen(1 To 49)
Dim intS As Integer, intT As Integer
Dim dblX As Double, intY As Integer, intZiehung As Integer
For intZiehung = 1 To 50 'Anzahl der Ziehungen bitte anpassen !!
For intT = LBound(intZahlen) To UBound(intZahlen)
'Zufallszahl zum Mischen der Grundzahlen und Verhindern von Dupletten :
dblMisch(intT) = Rnd()
intZahlen(intT) = intT
If intZiehung = 1 Then intGezogen(intT) = 0
Next
'Grundzahlen nach Zufallszahlen sortieren
For intS = LBound(intZahlen) To UBound(intZahlen)
For intT = 1 To intS
If dblMisch(intS) > dblMisch(intT) Then
intY = intZahlen(intS)
intZahlen(intS) = intZahlen(intT)
intZahlen(intT) = intY
dblX = dblMisch(intS)
dblMisch(intS) = dblMisch(intT)
dblMisch(intT) = dblX
End If
Next
Next
'Gezogene Zahlen aufaddieren (Merken, wie häufig welche Zahlen gezogen wurden) :
For intS = 1 To 6
intGezogen(intZahlen(intS)) = intGezogen(intZahlen(intS)) + 1
Next
'6 Zufallszahlen anzeigen
Cells(1, intZiehung).Resize(6) = Application.Transpose(intZahlen())
'Diese Funktion in Zeile 8 dient der Kontrolle : muss immer 6 ergeben !
Cells(8, intZiehung).FormulaArray = "=SUM(1/COUNTIF(R[-7]C:R[-2]C,R[-7]C:R[-2]C))"
Next
'Ausgabe der Anzahl gezogener Zahlen :
[A10:B10] = Array("Zahl :", "Gezogen :") 'Überschriften
For intS = LBound(intZahlen) To UBound(intZahlen)
Cells(intS + 10, 1) = intS
Cells(intS + 10, 2) = intGezogen(intS)
Next
'Absteigend Sortieren nach Anzahl gezogener Zahlen :
[A11].CurrentRegion.Sort Key1:=Range("B11"), Order1:=xlDescending
Cells.Columns.AutoFit 'Spaltenbreiten automatisch anpassen
End Sub

Gruß, NoNet
Anzeige
AW: Danke NoNet. Hab getestet und ist Prima!
01.09.2009 15:03:03
dieter(drummer)
Danke Nonet, für das tolle VBA Makro,
es ist immer wieder faszinierend, welch gute Spezialisten in diesem Forum sind!
Habs getestet und es hilft schon prima weiter.
Mit Gruß aus NRW
Dieter(drummer)
AW: Lotto 6 aus 49 - mehrere Ziehungen
01.09.2009 15:17:29
Luschi
Hallo Nonet,
warum steht in Zeile 8 eine Array-Formel, die sowieso nur 6 oder #DIV/0! als Ergebnis liefert.
6 wird immer ausgegeben, wenn in den darüberstehenden Zellen irgend etwas steht; egal ob Zahl oder beliebiger Text.
#DIV/0! erscheint, wenn mindestens eine Zelle leer ist.
Für B8 würde doch auch reichen =ANZAHL(B1:B6), da diese Funktion nur numerische Werte berücksichtigt.
Gruß von Luschi
aus klein-Paris
Anzeige
Falsch interpretiert, Luschi...
01.09.2009 15:47:43
NoNet
Hallo Luschi,
da hast Du den Nutzen dieser Funktion wohl falsch interpretiert : sie zeigt nicht an, wieviele Zellen im darüberliegenden Bereich gefüllt sind, sondern wieviele unterschiedliche Zahlen in diesen Zellen stehen, um den Nachweis zu erbringen, dass keine Redundanzen vorkommen !
Allerdings benötigt man diese Kontrolle gar nicht, da es durch die verwendete Methode weder rechnerisch noch logisch (!!) zu Redundanzen kommen kann : das nach Zufallszahl (RND()) sortierte ARRAY enthält in jedem Indexelement eine unterschiedliche Zahl (zw. 1 und 49) und es werden einfach die ersten 6 Elemente des ARRAYs als "gezogene Zahlen" ausgegeben.
Diese Methode ist (vor allem bei grossen Arrays mit vielen "gezogenen Zahlen") wesentlich schneller als die komplette Überprüfung nach jeder einzelnen "Ziehung", die dann wieder zu einer neuen Ziehung der gleichen "Kugel" führt.
Gruß, NoNet
Anzeige
AW: Lotto VBA autom. 6x6 aus Superlauf
01.09.2009 15:01:48
JogyB
Hi.
und hier auch noch meine selbstgebastelte Lösung:
Sub LoTTo()
Dim numBers(1 To 6, 1 To 6) As Long
Dim totalNum(1 To 49) As Long
Dim sortMax(1 To 49) As Long
Dim numStart As Long
Dim actNum As Long
Dim i As Long
Dim k As Long
Dim loTToEnd As Date
Dim temp As Long
Randomize
numStart = 1
' Läuft 5 Sekunden
loTToEnd = Now + TimeSerial(0, 0, 5)
Do
For actNum = 1 To 6
numBers(numStart, actNum) = Int(Rnd() * 49) + 1
' Überprüfung, ob die Zahl schon in der 6er-Folge vorkommt
If actNum > 1 Then
For i = 1 To actNum - 1
If numBers(numStart, actNum) = numBers(numStart, i) Then
actNum = actNum - 1
Exit For
End If
Next
' Wenn Schleife durchgelaufen, dann i = actnum, also Zahl ok
' Also zur Gesamtmenge addieren
If i = actNum Then
totalNum(numBers(numStart, actNum)) = totalNum(numBers(numStart, actNum)) +  _
1
End If
End If
Next
numStart = numStart Mod 6 + 1
Loop Until Now > loTToEnd
' Achtung: Numstart steht 1 zu hoch und aus 1 muss 6 werden
numStart = (numStart + 4) Mod 6 + 1
' Werte schreiben
For i = 1 To 6
For k = 1 To 6
' + 6, damit es nicht kleiner 0 wird
ActiveSheet.Cells(i, k).Value = numBers((i - numStart + 6) Mod 6 + 1, k)
Next
Next
' Werte sortieren
For i = 1 To 49
sortMax(i) = i
Next
For i = 1 To 49
For k = i + 1 To 49
If totalNum(sortMax(k)) > totalNum(sortMax(i)) Or _
(totalNum(sortMax(k)) = totalNum(sortMax(i)) And Rnd() >= 0.5) Then
temp = sortMax(k)
sortMax(k) = sortMax(i)
sortMax(i) = temp
End If
Next
Next
For i = 1 To 6
ActiveSheet.Cells(i + 9, 1).Value = sortMax(i)
Next
End Sub
Läuft in der Version 5 Sekunden, kannst Du aber natürlich anpassen.
Gruss, Jogy
Anzeige
AW: Danke auch an JogyB. Funtz prima!
01.09.2009 15:10:35
dieter(drummer)
Hi Jogy
Dir auch Dir meinen herzlichen Dank für das Makro. Funtz prima und werde es für mich weiter anpassen.
Kann mich nur widerholen, dass hier gute Spezialisten sind, die uneigennützige Hilfe geben. DANKE!
Gruß aus NRW
dieter(drummer)
kleiner Fehler
01.09.2009 16:06:08
JogyB
Hi.
Mir ist ein kleiner Fehler beim Schreiben der Werte passiert, habe da falschrum gedacht. Betrifft jetzt nur die Anordnung im 6x6 Feld. Anbei der korrigierte Code.
Sub LoTTo()
Dim numBers(1 To 6, 1 To 6) As Long
Dim totalNum(1 To 49) As Long
Dim sortMax(1 To 49) As Long
Dim numStart As Long
Dim actNum As Long
Dim i As Long
Dim k As Long
Dim loTToEnd As Date
Dim temp As Long
Randomize
numStart = 1
' Läuft 5 Sekunden
loTToEnd = Now + TimeSerial(0, 0, 1)
Do
For actNum = 1 To 6
numBers(numStart, actNum) = Int(Rnd() * 49) + 1
' Überprüfung, ob die Zahl schon in der 6er-Folge vorkommt
If actNum > 1 Then
For i = 1 To actNum - 1
If numBers(numStart, actNum) = numBers(numStart, i) Then
actNum = actNum - 1
Exit For
End If
Next
' Wenn Schleife durchgelaufen, dann i = actnum, also Zahl ok
' Also zur Gesamtmenge addieren
If i = actNum Then
totalNum(numBers(numStart, actNum)) = totalNum(numBers(numStart, actNum)) +  _
1
End If
End If
Next
numStart = numStart Mod 6 + 1
Loop Until Now > loTToEnd
' Achtung: Numstart steht 1 zu hoch und aus 1 muss 6 werden
numStart = (numStart + 4) Mod 6 + 1
' Werte schreiben
For i = 1 To 6
For k = 1 To 6
ActiveSheet.Cells(i, k).Value = numBers((i + numStart - 2) Mod 6 + 1, k)
Next
Next
' Werte sortieren
For i = 1 To 49
sortMax(i) = i
Next
For i = 1 To 49
For k = i + 1 To 49
If totalNum(sortMax(k)) > totalNum(sortMax(i)) Or _
(totalNum(sortMax(k)) = totalNum(sortMax(i)) And Rnd() >= 0.5) Then
temp = sortMax(k)
sortMax(k) = sortMax(i)
sortMax(i) = temp
End If
Next
Next
For i = 1 To 49
ActiveSheet.Cells(i + 9, 1).Value = sortMax(i)
ActiveSheet.Cells(i + 9, 2).Value = totalNum(sortMax(i))
Next
End Sub
Gruss, Jogy
Anzeige
AW: kleiner Fehler. Danke Jogy für Korrektur!
01.09.2009 16:32:41
dieter(drummer)
Danke für die tolle Hilfe, Jogy!
Gruss dieter(drummer)
AW: Info an Jogy
01.09.2009 16:47:38
dieter(drummer)
Hi Jogy,
habe mal den Durchlauf auf 60 Sekunden gesetzt und erreiche schon mehr als 1,5 Mio erreichte Häfigkeit bei Zahlen. Mir gefällt die Variante, dass ich z.B. auch mehr als 60 Sekunden nehmen kann.
Danke!
Gruss dieter(drummer)
AW: Fertiger Lottogenerator
02.09.2009 16:48:20
dieter(drummer)
Hi Yogy,
hast mir prima geholfen. Anbei die nun fertige Sache mit meinen dazugefügten Makro. Läuft Prima!
Hier die Datei: https://www.herber.de/bbs/user/64179.xls
Danke nochmal!
Gruss dieter(drummer)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige