VBA in Excel: Lotto Programm

Sykwitit

Sykwitit

Forum Master
Hallo!

Also ich muss ein Lotto Programm in VBA in Excel schreiben.

Es muss erstmals ein Feld mit den Zahlen von 1-49 generiert werden:
Code:
Sub Lotto()
Dim a As Integer, b As Integer
Dim zahl As Integer

zahl = 1
For Z = 1 To 7
    For s = 1 To 7
        Cells(Z, s).Value = zahl
        zahl = zahl + 1
    Next
Next
End Sub
Das funktioniert auch.

Jetzt hab ich dann Zufallszahlen generiert
Code:
Sub Zufall()
Dim zuf As Integer
Dim Field(1 To 49) As Integer
For i = 1 To 49
    For Z = 1 To 6
        Cells(8, Z) = Int(Rnd * 49) + 1
    Next
Next
funktioniert auch. ABER ich schreibe die Werte in die 8 Zeile rein. Aber die Aufgabe will, dass ich die generierten Werte in der Tabelle mit Rot hintersehe und dann in eine Textdatei ausgeben soll.

Einer ne Idee wie das geht?
 
Zellen einfärben kannst du beispielsweise wie folgt:

Code:
Range("E7").Select
With Selection.Interior
    .ColorIndex = 3   'rot
    .Pattern = xlSolid
End With

Hierbei müsstest du einfach die Zellennamen (hier "E7") per Variablen-Inhalten konkatenieren.
 
aha danke. und wie macht man das die Zelle mit den generierten Zahlen die er selber erkennt? mit ne if bedingung?
 
Code:
For Each zelle In Range("A1:G7")
   If (Cells = Range) Then
        
End If

Also ich hab mal herausgefunden, dass ich ne For each schleife brauche. Und mit der IF bedingung soll ich es vergleichen. Aber wie mach ich das genau? Hab keine Ahnung wie ich es vergleichen soll.
 
ähm, hast du nicht noch ein problem und zwar das zahlen doppelt "gezogen" werden können ?
 
Realsmasher schrieb:
ähm, hast du nicht noch ein problem und zwar das zahlen doppelt "gezogen" werden können ?

Ich kenn die random Funktion von VB nicht so gut. Bei C++ z.B. wirst du bei gleicher Inizialisierung sogar immer den selben Wert bekommen. Da löst man's meist, indem man die Init Werte z.B. mit der Systemzeit verknüpft. Wie auch immer, es braucht auf jeden Fall eine Abfrage/eine Markierung der bereits gezogenen Werte.
 
Realsmasher schrieb:
ähm, hast du nicht noch ein problem und zwar das zahlen doppelt "gezogen" werden können ?
hast recht..der zieht die zahlen doppelt.

mh..wo liegt den im code der fehler?
 
mh..wo liegt den im code der fehler?

Cells(8, Z) = Int(Rnd * 49) + 1

du lässt einfach neue zahlen ziehen, ohne zu prüfen ob diese schonmal gezogen werden.

leider kenne ich mich mit der sprache nicht aus, deswegen kann ich nicht sagen wie du es genau umgehen kannst, aber mal so als pseudocode(vertauschen mit der gequoteten zeile) :

Code:
wiederhole
  Cells(8, Z) = Int(Rnd * 49) + 1
  schon_vorhanden=0
  für i=1 bis Z-1
    falls cells(8,Z)==cells(8,i) dann schon_vorhanden=1
bis schon_vorhanden=0
 
Hab es jetzt so weit, dass ich KEINE gleichen Zahlen mehr generiere und die generierten Felder werden in der Tabelle markiert.

Code:
Sub Zufall()
    Dim zuf As Integer
    Dim Zelle As Range
    Dim z As Integer
    Dim zahlen As Variant
    Randomize (Time)
    
      zahlen = Array(1, 2, 3, 4, 5, 6)
    For i = 0 To 5
        zahlen(i) = Int(Rnd * 49) + 1

        For j = 0 To i - 1
            While zahlen(i) = zahlen(j)
 zahlen(i) = Int(Rnd * 49) + 1
            Wend
        Next
    Next
  
    
    Dim Field(1 To 49) As Integer
    
    Range("A1:G7").Select
    Range("G7").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    For H = 0 To 5
        For i = 1 To 7
            For j = 1 To 7
               If (Cells(i, j).Value = zahlen(H)) Then
                    'MsgBox zahlen(H)
                    Cells(i, j).Select
                    Cells(i, j).Interior.ColorIndex = 3
                                        
               End If
            Next
           
        Next
    Next
So jetzt brauch ich nur mehr eines:
Die "gezogenen" Zahlen in eine txt Datei exportieren.
 
Hab mal geschaut wie man die Daten ausgibt:
Code:
Sub TextExport()
   Dim rng As Range
   Dim iWks As Integer, iRow As Integer, iCol As Integer
   Dim sTxt As String, sPath As String
   sPath = Application.DefaultFilePath & "\"
   For iWks = 1 To Worksheets.Count
      Open sPath & Worksheets(iWks).Name & ".txt" For Output As #1
      Set rng = Worksheets(iWks).Range("A1").CurrentRegion
      For iRow = 1 To rng.Rows.Count
         For iCol = 1 To rng.Columns.Count
            sTxt = sTxt & Worksheets(iWks).Cells(iRow, iCol).Value & vbTab
         Next iCol
         Print #1, Left(sTxt, Len(sTxt) - 1)
         sTxt = ""
      Next iRow
      Close #1
   Next iWks
   MsgBox "Sie finden die Textdateien im Ordner " & Left(sPath, Len(sPath) - 1)
End Sub
Das Problem jetzt ist, dass er ALLE Daten in der Tabelle ausgibt. Also nicht die generierten Zahlen, die gewünscht sind. Wie kann man den die generierten Zahlen den in die Textdatei übergeben?
 
vielleicht bin ich auf dem holzweg, aber ich seh das so :

Code:
For iRow = 1 To rng.Rows.Count
         For iCol = 1 To rng.Columns.Count
            sTxt = sTxt & Worksheets(iWks).Cells(iRow, iCol).Value & vbTab
         Next iCol
         Print #1, Left(sTxt, Len(sTxt) - 1)
         sTxt = ""
      Next iRow


hier gibs du praktisch ALLE zeilen und spalten aus, welche jemals benutzt wurden(rng.rows.count = vom registrierte Reihen ?)

wenn du nur bestimmte willst, brauchst du doch im prinzip nur die for schleife auf die reihen und spalten anpassen, welche du nutzt und ausgeben willst.

z.b.

[ ][ ][ ][ ]
[ ][j][j][ ]
[ ][j][j][ ]
[ ][ ][ ][ ]

willst du jetzt nur alle Felder wo "j" drinne steht ginge das so :

Code:
For iRow = 2 To 3
         For iCol = 2 To 3
etc
siehe oben


aber wie gesagt, kenne die sprache nicht, also kanns sein das dies so nicht funktioniert.
 
da hast recht, aber durch die Random Funktion werden irgendwelche Zahlen rot hinterlegt. Und die Tabelle enthält die Zahlen 1-49 und schreibt sie mir auch so in die TXT Datei rein. Dann schaut es etwa so aus:

1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 32 33 34 35
36 37 38 39 40 41 42
43 44 45 46 47 48 49

Aber ich denk mal ich muss es beim Zufallsgenerator es machen:
Code:
  For H = 0 To 5
        For i = 1 To 7
            For j = 1 To 7
               If (Cells(i, j).Value = zahlen(H)) Then
                    'MsgBox zahlen(H)
                    Cells(i, j).Select
                    Cells(i, j).Interior.ColorIndex = 3
                    'Cells(i, j).Interior.Pattern = xSolid
                    
               End If
            Next
           
        Next
    Next
Denn in der If-Bedingung, werden ja die Zellen ausgewählt und mit der Farbe hinterlegt. Und jetzt muss ich wohl da es hinschreiben, wie er jetzt die generierten Zahlen in eine Text Datei exportiert und da komme ich nicht weiter mit dem Code da.

Code:
'Sub Datei()
 '   Dim fso As FileSystemObject
  '  Dim ts As File
    
   ' Set fso = CreateObject("Scripting.File")
    'Set ts = fos.OpenTextFile("C:\test.txt", ForWritting, True)
'End Sub
Geht aber nicht wirklich..
 
einfache frage und 2 fliegen mit einer klappe :

warum gibst du nicht die gezogenen zahlen nochmal extra in einer spalte aus ?

da hättest du
a) nochmal eine zusätzliche anzeige ohne die ganzen "ungezogenen" dazwischen :p
b) könntest das ganze sehr leicht rausgeben
 
juhu es klappt wunderbar!!:)

Code:
Sub Zufall()
    Dim zuf As Integer
    Dim Zelle As Range
    Dim z As Integer
    Dim zahlen As Variant
    Randomize (Time)
    
    'zahlen = Array(Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1)
    zahlen = Array(1, 2, 3, 4, 5, 6)
    For i = 0 To 5
        zahlen(i) = Int(Rnd * 49) + 1
        [COLOR="Red"]Cells(i + 10, z + 10) = zahlen(i)[/COLOR]
              
        For j = 0 To i - 1
            While zahlen(i) = zahlen(j)
                   zahlen(i) = Int(Rnd * 49) + 1
        [COLOR="Red"] Cells(i + 10, z + 10) = zahlen(i)[/COLOR]
            Wend
        Next
    Next
    'MsgBox zahlen(0)
    
    Dim Field(1 To 49) As Integer
    
    Range("A1:G7").Select
    Range("G7").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    For H = 0 To 5
        For i = 1 To 7
            For j = 1 To 7
               If (Cells(i, j).Value = zahlen(H)) Then
                    'MsgBox zahlen(H)
                    Cells(i, j).Select
                    Cells(i, j).Interior.ColorIndex = 3
                    'Cells(i, j).Interior.Pattern = xSolid
                    
               End If
            Next
           
        Next
    Next
End Sub
Aber eventuell zum verfeinern hätt ich da noch ne Frage:
Wie gebe ich die generierten Zahlen nebeneinander aus?
Derzeit werden die Zahlen untereinander ausgegeben, anstatt nebeneinander. Auch in der Textdatei werden die Zahlen untereinander ausgegeben.

Außerdem erzeugt das Makro für die Textdatei erzeugung nicht 1 TXT File, sondern gleich 3, wobei nur die 1. Datei den Inhalt hat. Wobei die Zahlen sogar richtig geordnet ausgegebn wird.

DANKE schonmal
 
weiß zwar nicht was du jetzt genau gemacht hast, aber solange es funktioniert :)

Wie gebe ich die generierten Zahlen nebeneinander aus?

meinst du damit nebeneinander in eine zelle oder in mehrere verteilt ?

wenn letzteres gemeint ist musst du doch nur die indexe von "cells()" bzw die for schleifen ein wenig verdrehen.

wenn ersteres gemeint ist wäre es wohl das leichteste alle zahlen in strings umzuwandeln und in einen String "hinein zu addieren", wobei ich nicht weiß ob diese 2 funktionen(int-> string und strings addieren) dort überhaupt verfügbar sind.

die ausgabe in eine datei wäre mit letzterer methode natürlich sehr einfach.
 
So nachdem ich ziemlich viel um die Ohren hatte und noch für 1 Woche Stress habe. :mad: Bin ich zum Glück schon mit meinem Projekt fertig.

Nen Dank an design2006, Zerocool und nicht zu vergessen Realsmasher!!! :)
und hier der Funktionierende Source Code
Code:
Sub Lotto()
Dim a As Integer, b As Integer
Dim zahl As Integer


zahl = 1
For z = 1 To 7
    For S = 1 To 7
        Cells(z, S).Value = zahl
        zahl = zahl + 1
    Next
Next

End Sub

Sub Zufall()
    Dim zuf As Integer
    Dim Zelle As Range
    Dim z As Integer
    Dim zahlen As Variant
    Randomize (Time)
    
    'zahlen = Array(Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1, Int(Rnd * 49) + 1)
    zahlen = Array(1, 2, 3, 4, 5, 6)
    For i = 0 To 5
        zahlen(i) = Int(Rnd * 49) + 1
             Cells(i + 10, z + 1) = zahlen(i)
              
        For j = 0 To i - 1
            While zahlen(i) = zahlen(j)
                zahlen(i) = Int(Rnd * 49) + 1
                Cells(i + 10, z + 1) = zahlen(i)
            Wend
        Next
    Next
    'MsgBox zahlen(0)
    
    Dim Field(1 To 49) As Integer
    
    Range("A1:G7").Select
    Range("G7").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    For H = 0 To 5
        For i = 1 To 7
            For j = 1 To 7
               If (Cells(i, j).Value = zahlen(H)) Then
                    'MsgBox zahlen(H)
                    Cells(i, j).Select
                    Cells(i, j).Interior.ColorIndex = 3
                    'Cells(i, j).Interior.Pattern = xSolid
                    
               End If
            Next
           
        Next
    Next
End Sub

Sub TextExport()
   Dim rng As Range
   Dim sPath As String
   sPath = "C:\Users\Sykwitit\Desktop\BADV PROJEKT\"
   
      Open sPath & Worksheets(1).Name & ".txt" For Output As #1
      Set rng = Worksheets(1).Range("A10:A15")
      With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("A10:A15")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
      
      For Each z In rng
               
         Print #1, z.Value
       Next
      Close #1
      MsgBox "Sie finden die Textdateien im Ordner " & Left(sPath, Len(sPath) - 1)
End Sub

Sub TextAnzeigen()
    Shell "C:\Windows\System32\notepad.exe C:\Users\Sykwitit\Desktop\BADV PROJEKT\Tabelle1.txt"
End Sub
 

Ähnliche Themen

Vaio FZ WinDvD Problem

Asus n51tp oder hp pavilion dm3-1010

Asus Notebook und Windows 7

Notebook zu heiss...

Pavilion dv9767eg Sound Treiber

Zurück
Oben