Lotto Excel VBA Zahlen in Lottoschein drucken und Gewinnauswertung programmieren

Lotto Excel VBA Zahlen in Lottoschein drucken und Gewinnauswertung programmieren

Author D.Selzer-McKenzie

Video: https://youtu.be/C4cxHcjc8oI

Hier zeige ich Ihnen, wie Sie mit Excel direkt Ihre Zahlen in den Lottoschein drucken (also ankreuzen) können und wie Sie auch eine umfangreiche Gewinnauswertung mit reihenweiser Zahlen vornehmen können.

Den SourceCode können Sie im Forum

http://Outbackbrumby.Blogspot.com

herunterladen.

Hier der SourceCode VBA:

 

' Alle Variablen die in diesem Modul mit dem Zeichen L

' anfangen sind mit dem Datentyp Long deklariert

DefLng L

 

Public Sub MyArray()

   Dim lngArr1(1 To 45)

   Dim lngArr2(1 To 6)

   Dim lngC, lngX

 

   ' Das Array wird mit 45 Zahlen gefüllt

   For lngC = 1 To 45

      lngArr1(lngC) = lngC

   Next

 

   ' Sechs Zufallszahlen werden aus dem Array ausgelesen

   For lngC = 1 To 6

  

      ' Schleife bis ein Wert > 0 geliefert wird

      Do

         lngX = Int(Rnd * 45) + 1

      Loop Until lngArr1(lngX) > 0

 

      ' Spielzahlen speichern

      lngArr2(lngC) = lngX

     

      ' gezogene Zahl in Datenfeld mit 0 ersetzen

      lngArr1(lngX) = 0

   Next

 

   ' Den Inhalt des Arrays Arr1 an das Direktfenster übergeben

   For lngC = 1 To 45: Debug.Print lngArr1(lngC),: Next

  

   ' Eine leere Zeile im Direktfenster erzeugen

   Debug.Print

  

   ' Den Inhalt des Arrays Arr1 an das Direktfenster übergeben

   For lngC = 1 To 6: Debug.Print lngArr2(lngC),: Next

 

End Sub

DefLng L

 

Public Sub PlayAGame()

   Dim lngArr1(1 To 45)

   Dim lngArr2(1 To 6)

   Dim lngGames, lngRow, lngC, lngX

 

   Application.ScreenUpdating = False

  

   With ActiveSheet

      ' alle Zeilen ab Zeile 5 löschen

      .UsedRange.Offset(4, 0).Delete

     

      ' Anzahl Spielfelder

      lngGames = Application.InputBox _

                ("Geben sie die Anzahl der Spielfelder ein", _

                  Title:="Wieviele Spiele?", _

                  Default:=2)

 

      ' Zur Anzahl Spielfelder eine 4 addieren, damit erst ab

      ' 5. Zeile die Spielzahlen eingetragen werden

      lngGames = lngGames + 4

  

      ' Ab Zeile 5 die Zufallszahlen eintragen

      For lngRow = 5 To lngGames

     

         ' Das Array wird mit 45 Zahlen gefüllt

         For lngC = 1 To 45

            lngArr1(lngC) = lngC

         Next

     

         ' Sechs Zufallszahlen  aus dem Array auslesen

         For lngC = 1 To 6

        

            ' Schleife bis ein Wert > 0 geliefert wird

            Do

               lngX = Int(Rnd * 45) + 1

            Loop Until lngArr1(lngX) > 0

     

            ' Spielzahlen speichern

            lngArr2(lngC) = lngX

           

            ' gezogene Zahl in Datenfeld mit 0 ersetzen

            lngArr1(lngX) = 0

         Next

        

         ' Nummerierung in der Spalte A

         .Cells(lngRow, "A").Value = lngRow - 4 & ".)"

 

         ' Zufallszahlen aus dem Array an das Spielfeld übergeben

         .Cells(lngRow, "B").Resize(1, 6).Value = lngArr2

      Next lngRow

   End With

 

   Application.ScreenUpdating = True

End Sub

 

Public Sub DidYouWin()

   Dim rngArea1   As Range

   Dim rngArea2   As Range

   Dim rngCell    As Range

   Dim lngGames   As Long

   Dim lngRow     As Long

  

   Application.ScreenUpdating = False

  

   With ActiveSheet

      ' Ermitteln, wieviele Spiele gespielt wurden

      ' Letzte Zeile in Spalte A ermitteln

      lngGames = .Cells(.Rows.Count, "A").End(xlUp).Row

     

      ' Spielebereich definieren

      Set rngArea1 = .Range("B5:G" & lngGames)

      Set rngArea2 = .Range("H5:I" & lngGames)

     

      ' Farben und Zellinhalt von letzter Auswertung leeren

      rngArea1.Interior.Color = xlNone

      rngArea2.Value = ""

     

      ' Alle Zufallszahlen durchlaufen

      For Each rngCell In rngArea1

         ' Gewinnzahlen überprüfen

         If Application.CountIf( _

               .Range("B1:G1"), rngCell.Value) > 0 Then

           

            rngCell.Interior.Color = RGB(255, 0, 0) ' rot

         ' Zusatzzahl überprüfen

         ElseIf rngCell.Value = Range("I1").Value Then

            rngCell.Interior.Color = RGB(255, 255, 0) ' gelb

           

            ' Vermerk dass Zusatzzahl getippt wurde

            .Cells(rngCell.Row, "I").Value = "X"

         End If

      Next rngCell

 

      ' Prüfung Anzahl Treffer je Zeile

      For lngRow = 1 To rngArea1.Rows.Count

         ' Anzahl Treffer in Spielzahlen durch ausgewertete Tabellenfunktion

         rngArea2.Cells(lngRow, 1).Value = _

            Evaluate("=SUM(COUNTIF(B$1:$G$1," & _

                     rngArea1.Rows(lngRow).Address & "))")

      Next lngRow

 

      ' Prüfung, ob Spiele mit mind. 3 Treffern vorhanden sind

      If Application.Max(rngArea2) > 2 Then

         MsgBox "Du hast etwas gewonnen :-)))", _

                vbInformation, "Gewonnen!"

      Else

         MsgBox "Diesmal hat es leider nicht geklappt :-(", _

                 vbCritical, "Leider verloren"

      End If

   End With

End Sub