Unlösbare Aufgabe?

[mini80]

Kanns kaum erwarten

[MisterBurns]

Kanns kaum erwarten?
Entschuldige bitte mal, aber du scheinst zu vergessen, dass dies hier ein Forum ist, in dem Leute in ihrer Freizeit kostenlos ihre Hilfe anbieten. Und es ist auch nicht so, dass alle nur gewartet haben, bis du endlich mit einem Problem um die Ecke kommst.
Warte daher eine angemessene Zeit, du wirst schon eine Rückmeldung erhalten. Wenn sich nach 1-2 Tagen tatsächlich niemand mehr gemeldet haben sollte, kannst du immer noch nachfragen. Und falls es dir hier nicht schnell genug gehen sollte, kannst du auch gerne mal bei einem Dienstleister anfragen, der löst dein Problem ratzfatz.
Und letztlich hast du selbst geschrieben, dass es eine "unlösbare Aufgabe" ist. Wieso glaubst du dann, dass man dir binnen 10 Minuten eine Lösung zaubern kann?

Soweit für dich nachvollziehbar?


So, nachdem das mal geklärt ist, kommen wir zum Kern der Sache. Ich hab dir mal eine Lösung für die Gerade/Ungerade und 18/36 Spalten gemacht:

Code:

Sub Gerade_Ungerade()
Dim i As Integer, Z As Integer, letzte As Integer
Dim Zaehler As Integer, Einzel As Integer, Serie As Integer

letzte = Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
For i = 1 To letzte
   If Cells(i, 1) Mod 2 = 0 Then           'Erster Eintrag ist gerade
       Do Until Cells(Z, 1) Mod 2 > 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   Else                                    'Erster Eintrag ist ungerade
       Do Until Cells(Z, 1) Mod 2 = 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   End If
   
   If Zaehler = 1 Then
       Einzel = Einzel + 1
   Else
       Serie = Serie + 1
   End If
   
   Zaehler = 0
   i = Z - 1
Next i


Cells(letzte + 1, 3) = Einzel & " Einzel"
Cells(letzte + 2, 3) = Serie & "Serie"
   
End Sub


Sub Achtzehn_Sechsundreissig()
Dim i As Integer, Z As Integer, letzte As Integer
Dim Zaehler As Integer, Einzel As Integer, Serie As Integer

letzte = Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
For i = 1 To letzte
   If Cells(i, 1) <= 18 Then           'Erster Eintrag ist gerade
       Do Until Cells(Z, 1) > 18
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   Else                                    'Erster Eintrag ist ungerade
       Do Until Cells(Z, 1) <= 18
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   End If
   
   If Zaehler = 1 Then
       Einzel = Einzel + 1
   Else
       Serie = Serie + 1
   End If
   
   Zaehler = 0
   i = Z - 1
Next i
 
Cells(letzte + 1, 11) = Einzel & " Einzel"
Cells(letzte + 2, 11) = Serie & "Serie"
   
End Sub

Für das schwarz/rot musst du warten, bis ich dazu komme (oder jemand anderes). Und ja, es wird mindestens bis morgen Abend dauern, bis ich dazu komme.

[mini80]

Hallo Berni, ich finde das total nett von Dir. Könntest Du mir dann die Datei wieder anhängen, dass ich das anhand der Datei nachvollziehen kann?
Du kannst Dir aber gerne noch Zeit lassen ich wollte Dich nicht stressen

[mini80]

huhu bernie, ich kriegs nicht gebacken, kannst du mir bitte nochmal helfen?

[MisterBurns]

Ich hatte doch geschrieben, dass ich nicht vor heute Abend dazukomme. Also nochmal - hab Geduld, es wird nicht schneller gehen (eher im Gegenteil), wenn du öfter schreibst.
Hier also der komplette Code für Gerade/Ungerade, Rot/Schwarz und kleiner/größer 18.

Code:

Option Explicit

Sub Gerade_Ungerade()
Dim i As Integer, Z As Integer, letzte As Integer
Dim Zaehler As Integer, Einzel As Integer, Serie As Integer

letzte = Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
For i = 1 To letzte
   If Cells(i, 1) Mod 2 = 0 Then           'Erster Eintrag ist gerade
       Do Until Cells(Z, 1) Mod 2 > 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   Else                                    'Erster Eintrag ist ungerade
       Do Until Cells(Z, 1) Mod 2 = 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   End If
   
   If Zaehler = 1 Then
       Einzel = Einzel + 1
   Else
       Serie = Serie + 1
   End If
   
   Zaehler = 0
   i = Z - 1
Next i


Cells(letzte + 1, 3) = Einzel & " Einzel"
Cells(letzte + 2, 3) = Serie & " Serie"
   
End Sub


Sub Achtzehn_Sechsundreissig()
Dim i As Integer, Z As Integer, letzte As Integer
Dim Zaehler As Integer, Einzel As Integer, Serie As Integer

letzte = Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
For i = 1 To letzte
   If Cells(i, 1) <= 18 Then           'Erster Eintrag ist gerade
       Do Until Cells(Z, 1) > 18
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   Else                                    'Erster Eintrag ist ungerade
       Do Until Cells(Z, 1) <= 18
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   End If
   
   If Zaehler = 1 Then
       Einzel = Einzel + 1
   Else
       Serie = Serie + 1
   End If
   
   Zaehler = 0
   i = Z - 1
Next i
 
Cells(letzte + 1, 11) = Einzel & " Einzel"
Cells(letzte + 2, 11) = Serie & " Serie"
   
End Sub


Sub rot_schwarz()
Dim i As Integer, Z As Integer, letzte As Integer
Dim Zaehler As Integer, Einzel As Integer, Serie As Integer

letzte = Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
For i = 1 To letzte
   If WorksheetFunction.CountIf(Sheets("Tabelle2").Columns(1), Cells(i, 1)) = 1 Then   'Erster Eintrag ist rot
       Do Until WorksheetFunction.CountIf(Sheets("Tabelle2").Columns(1), Cells(Z, 1)) = 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   Else                                    'Erster Eintrag ist schwarz
       Do Until WorksheetFunction.CountIf(Sheets("Tabelle2").Columns(2), Cells(Z, 1)) = 0
           Zaehler = Zaehler + 1
           Z = Z + 1
           If Z > letzte Then Exit Do
       Loop
   End If
   
   If Zaehler = 1 Then
       Einzel = Einzel + 1
   Else
       Serie = Serie + 1
   End If
   
   Zaehler = 0
   i = Z - 1
Next i
 
Cells(letzte + 1, 7) = Einzel & " Einzel"
Cells(letzte + 2, 7) = Serie & " Serie"
   
End Sub

Klicke in deiner Datei mit der rechten Maustaste auf den Reiter von "Tabelle1" und wähle "Code anzeigen". Es öffnet sich der VBA-Editor. In dem großen weißen Fenster (das leer sein sollte) fügst du den Code genau so ein, wie er oben steht, von der ersten bis zur letzten Zeile. Nun schließt du den Editor wieder.

In der Menüleiste gibt es den Reiter "Ansicht". Dort findest du ganz rechts "Makros". Wenn du darauf klickst, werden dir die 3 Makros angezeigt. Führst du nun eines davon aus, wird in die erste freie Zeile (in deiner Beispieldatei Zeile 99) eingetragen, wieviele Einzel und wieviele Serien es für den entsprechendn Block gibt. Führst du also zB das Makro "Gerade_Ungerade" aus, wird in C99 der Wert der Einzel und in C100 der Wert der Serie eingetragen.

Du willst vermutlich für alle drei Blöcke die Ergebnisse auf einmal erhalten. Dann kannst du noch einen weiteren Code im VBA-Editor einfügen, der alle Makros auf einmal ablaufen lässt:

Code:

Sub Ergebnisse()
Call Gerade_Ungerade
Call Achtzehn_Sechsundreissig
Call rot_schwarz
End Sub

Kommst du damit klar?

Ach ja, zu deiner Nachricht von heute: Wenn du wirklich bereit bist, Geld dafür zu bezahlen, dann spende den Betrag, von dem du glaubst dass er meine Arbeit wert ist, für Kinder oder Tiere in Not. Es sollte dir nicht schwer fallen, einen passenden Empfänger zu finden (leider).

[mini80]

Scheisse bist Du gut!!!! Werde ich machen! Vielen herzlichen Dank

[BoskoBiati]

Hi,

ich denke, Roulette-Statistiken gibt es doch genügend im Netz. Ich würde das so machen:



  Muster_Vorlage.xlsx (Größe: 26,66 KB / Downloads: 10)

[snb]

@Bosko

In H3:

PHP-Code:

=N(MOD(G3;2)=0) 


In J3:

PHP-Code:

=N(G3>18)