Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
652to656
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
652to656
652to656
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bitte um Hilfe Lotto

Bitte um Hilfe Lotto
20.08.2005 00:03:09
molle
Hallo zusammen
Ein Lottospielschein Vollsysrem hat 6 Kästchen.
mit diesem Code werden 7 Zahlen gezogen
Dim zuf As Integer
Dim arr(8) As Variant
Dim az As Integer
Dim merk As Long
Dim za As Integer
Dim zei As Integer
Range("K38:S43") = ""
zei = 37
Do While zei zuf = Int((49 - 1 + 1) * Rnd + 1)
merk = 0
' prüfen ob Zahl schon vorhanden
For az = 0 To za
If zuf = arr(az) Then merk = merk + 1
Next az
' Zahl in Array schreiben
If merk = 0 Then
arr(za) = zuf
za = za + 1
End If
If za > 7 Then
zei = zei + 1
Range("D" & zei, "j" & zei) = arr
za = 0
' Zeile aufsteiegnd sortieren
Range("D" & zei, "j" & zei).Sort Key1:=Range("D" & zei), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
End If
Loop
Kann mir ein Profi den Code so Umschreiben das ich bei Klick auf das Makro nochmal 7 Zahlen ziehe ,nur sollen die 7 Zahlen eine Zeile weiter unten
eingefügt werden.Die esten zahlen dürfen aber nicht gelöscht werden.
mfg Molle

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe Lotto
20.08.2005 00:32:31
Erich
Hallo Molle,
isses das?

Sub lott()
Dim zuf As Integer
Dim arr(8) As Variant
Dim az As Integer
Dim merk As Long
Dim za As Integer
Dim zei As Integer, plus As Integer
If IsEmpty(Range("D38")) Then
plus = 0
Else
plus = Range("D65536").End(xlUp).Row + 1 - 37
End If
Range("K38:S43") = ""
zei = 37 + plus
Randomize
Do While zei < 43 + plus
zuf = Int((49 - 1 + 1) * Rnd + 1)
merk = 0
' prüfen ob Zahl schon vorhanden
For az = 0 To za
If zuf = arr(az) Then merk = merk + 1
Next az
' Zahl in Array schreiben
If merk = 0 Then
arr(za) = zuf
za = za + 1
End If
If za > 7 Then
zei = zei + 1
Range("D" & zei, "j" & zei) = arr
za = 0
' Zeile aufsteiegnd sortieren
Range("D" & zei, "j" & zei).Sort Key1:=Range("D" & zei), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
End If
Loop
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Bitte um Hilfe Lotto
20.08.2005 00:47:33
molle
Hallo Erich
ich Habe noch etwas vergessen
das nächste Makro soll 8 Zahlen Ziehen, es mus aber erkennen das in den anderen Zeilen
schon Zahlen Stehn.
Werde mich Morgen wieder Melden.
mfg Molle

AW: Bitte um Hilfe Lotto die erste
20.08.2005 10:59:56
M
Hallo Erich Habe Code etwas geändert

Sub Lotto()
' Rechteck1_BeiKlick Makro
' Makro am 20.08.2005 von Molle aufgezeichnet
Dim zuf As Integer
Dim arr(8) As Variant
Dim az As Integer
Dim merk As Long
Dim za As Integer
Dim zei As Integer, plus As Integer
If IsEmpty(Range("D12")) Then
plus = 0
Else
plus = Range("D18").End(xlUp).Row + 1 - 12
End If
zei = 11 + plus
Randomize
Do While zei < 12 + plus
zuf = Int((49 - 1 + 1) * Rnd + 1)
merk = 0
' prüfen ob Zahl schon vorhanden
For az = 0 To za
If zuf = arr(az) Then merk = merk + 1
Next az
' Zahl in Array schreiben
If merk = 0 Then
arr(za) = zuf
za = za + 1
End If
If za > 7 Then
zei = zei + 1
Range("D" & zei, "j" & zei) = arr
za = 0
' Zeile aufsteiegnd sortieren
Range("D" & zei, "j" & zei).Sort Key1:=Range("D" & zei), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
End If
Loop
End Sub

Nun ein neues Problem
Das Nächste Makro soll jetzt 8 Zahlen Ziehen habe den Code schon geschrieben,das Problem
es soll erkennen dass schon in den anderen Zeilen schon Zahlen stehen.
zb.7 Zahlen Range D12:J12,D13:J13
8 Zahlen Range D14:K14,D15:K15.
mfg Molle
Anzeige
AW: Bitte um Hilfe Lotto die erste
20.08.2005 14:39:50
Erich
Hallo Molle,
das folgende Makro schreibt bei jedem Start ab D12 zwei Zeilen mit Zufallszahlen Wenn 13 leer ist, werden 7, sonst 8 Zufallszahlen pro Zeile geschrieben.
Damit erfüllt es deinen Wunsch:
zb.7 Zahlen Range D12:J12,D13:J13
8 Zahlen Range D14:K14,D15:K15

Sub Lotto()
' Rechteck1_BeiKlick Makro
' Makro am 20.08.2005 von Molle aufgezeichnet
Dim zuf As Integer
Dim arr(8) As Variant
Dim az As Integer
Dim merk As Long
Dim za As Integer
Dim zei As Integer, plus As Integer, beg As Integer, spa As Integer
If IsEmpty(Range("D12")) Then
beg = 12
Else
beg = Range("D65536").End(xlUp).Row + 1
End If
If IsEmpty(Range("D13")) Then spa = 7 Else spa = 8
zei = beg
Randomize
Do While zei <= beg + 1
zuf = Int(49 * Rnd + 1)
merk = 0
' prüfen ob Zahl schon vorhanden
For az = 0 To za
If zuf = arr(az) Then merk = 1: Exit For
Next az
' Zahl in Array schreiben
If merk = 0 Then
arr(za) = zuf
za = za + 1
End If
If za > spa Then
Range("D" & zei, Cells(zei, spa + 3)) = arr
' Zeile aufsteiegnd sortieren
Range("D" & zei, Cells(zei, spa + 3)).Sort _
Key1:=Range("D" & zei), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
za = 0
zei = zei + 1
End If
Loop
End Sub

Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Bitte um Hilfe Lotto Danke Erich
21.08.2005 00:01:01
molle
Alles Klar

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige