Sammlung ==> #26 VBA: Lotto-Zahlen-Generator

VBA: Lotto-Zahlen-Generator:

Gastbeitrag

Gibt es eine Strategie zum Knacken des Lotto-Jackpots? So viel kann man sagen: Sollte man alle Zahlen getroffen haben, dann ist es gut, wenn man möglichst alleine die entsprechenden Zahlen hat! Denn wenn auch andere Lotto-Teilnehmer dieselben Zahlen aus dem Ziehungsergebnis haben, muss man den Gewinn teilen und die Ausschüttung reduziert sich rapide. Insofern gibt es gute Argumente dafür, dass man möglichst zufällig ausgewählte Zahlen tippt, da hier die Wahrscheinlichkeit relativ gering ist, dass andere die Zahlen ebenos gewählt haben. Gastautor Hans Bon stellt excelfunktionen.de ein entsprechendes Tool zur Verfügung. Eine kleine Exceldatei, die mittels VBA Lotto-Zahlen auf Mausklick zufällig generiert.

Die Programmierung liefert 12 mal 6 zufällige Zahlen, die Tabelle kann ausgedruckt werden und zum Lotto-Tippen verwendet werden.

Excelfunktionen.de möchte natürlich nicht das Lotto-Fieber in den Vordergrund stellen, sondern wir bieten diesen Download auch deshalb an, weil die Programmierung interessant ist. Der Code ist offen und kann mittels ALT + F11 in der Exceldatei eingesehen werden. Zusätzlich steht er am Ende dieses Abschnittes hier bereit. (Hinweis: Beim Öffnen der Exceldatei müssen die Makros aktiviert werden.)

Wir stellen Ihnen das Sheet als XLS-File lotto3.xls [35 kb] zum herunterladen hier zur Verfügung!

Für Rückfragen steht Ihnen der Gastautor gerne zur Verfügung. Senden Sie eine Mail an uns, wie bemühen uns dann um Hilfestellung.

Vielen Dank an Hans Bon. Er ist unter anderem auch Autor des Programms Einstufungstest - basierend auf MS-Excel von Basel & Bon.

Der Code:

Sub Number() '6 Zufallszahlen von 1-49 ziehen
Sheets("tabelle1").Select
[b5:x10] = ""
Range("A10").Select

For F = 1 To 12

'1.Zahl ermitteln
Randomize
z1 = Int((49 * Rnd) + 1)
'2.Zahl ermitteln
Randomize
z2 = Int((49 * Rnd) + 1)
While z2 = z1
Randomize
z2 = Int((49 * Rnd) + 1)
Wend
'3.Zahl ermitteln
Randomize
z3 = Int((49 * Rnd) + 1)
While z3 = z1 Or z3 = z2
Randomize
z3 = Int((49 * Rnd) + 1)
Wend
'4.Zahl ermitteln
Do Until zähler = 3
zähler = 0
z4 = Int((49 * Rnd) + 1)
If z4 <> z1 Then zähler = zähler + 1
If z4 <> z2 Then zähler = zähler + 1
If z4 <> z3 Then zähler = zähler + 1
Loop
'5.Zahl ermitteln
Do Until zähler = 4
zähler = 0
z5 = Int((49 * Rnd) + 1)
If z5 <> z1 Then zähler = zähler + 1
If z5 <> z2 Then zähler = zähler + 1
If z5 <> z3 Then zähler = zähler + 1
If z5 <> z4 Then zähler = zähler + 1
Loop
'6.Zahl ermitteln
Do Until zähler = 5
zähler = 0
z6 = Int((49 * Rnd) + 1)
If z6 <> z1 Then zähler = zähler + 1
If z6 <> z2 Then zähler = zähler + 1
If z6 <> z3 Then zähler = zähler + 1
If z6 <> z4 Then zähler = zähler + 1
If z6 <> z5 Then zähler = zähler + 1
Loop

'Zahlen den Zellen zuordnen

ActiveCell.Offset(-5, 2).Activate
ActiveCell = z1
ActiveCell.Offset(1, 0).Activate
ActiveCell = z2
ActiveCell.Offset(1, 0).Activate
ActiveCell = z3
ActiveCell.Offset(1, 0).Activate
ActiveCell = z4
ActiveCell.Offset(1, 0).Activate
ActiveCell = z5
ActiveCell.Offset(1, 0).Activate
ActiveCell = z6

Next F

'Zahlen aufsteigend sortieren

Range("C5:C10").Select
Selection.Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("e5:e10").Select
Selection.Sort Key1:=Range("e5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("g5:g10").Select
Selection.Sort Key1:=Range("g5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("i5:i10").Select
Selection.Sort Key1:=Range("i5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A10").Select
Range("k5:k10").Select
Selection.Sort Key1:=Range("k5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("m5:m10").Select
Selection.Sort Key1:=Range("m5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("o5:o10").Select
Selection.Sort Key1:=Range("o5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("q5:q10").Select
Selection.Sort Key1:=Range("q5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("s5:s10").Select
Selection.Sort Key1:=Range("s5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("u5:u10").Select
Selection.Sort Key1:=Range("u5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("w5:w10").Select
Selection.Sort Key1:=Range("w5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("y5:y10").Select
Selection.Sort Key1:=Range("y5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
End Sub

excelfunktionen.de | Nov. 2006