Bingokarten Zahlen mit Zufallszahlen und Rang erstellen

Question

Hallo und einen schönen Tag an das Forum

Bevor ich hier eine Frage stelle probiere ich erst fast alles aus um eine Lösung zu finden und erkundige mich, ob nicht schon eine Lösung vorhanden ist. Doch leider habe ich nichts gefunden das was zu meinem Anliegen passt.

Bingo Zahlen mit Zufallsbereich ist nicht das Problem was ich habe, sondern, das ich die Zellen H4 bis h8 mit der Anweisung ist Zufallszahl = B9:B23; D9:D23;-1); D9:D23>10)I4 bis I8 ist Zufallszahl = B24:B38; D24:D38;-1); D24:D38>10) , in J4 bis J5 = B39:B53; D39:D53;-1);!D39:D53>13) , in J7 bis J8 =B39:B53; D39:D53;-1); D39:D53>11)*(D39:D53<14)) in K4 bis K8 = (B54:B68; D54:D68;-1); D54:D68>10) und in L4 bis L8= (B69:B83; D69:D83;-1); D69:D83>10) beleg werden.

Wie kann ich das erreichen?

Gruß Adde

Answer 1

Hallo Affe

Vba kentnisse vorrausgesetzt!

Auf die schnelle,nicht optimiert!

Als Ansatz vielleicht!

Einfach mal Starten,dann siehst was da passiert!

Gruß Nighty

Option Explicit
Sub Bingo()
    Randomize Timer
    Dim zahl(25) As Integer, endeindex As Integer, allezahlen As Integer, ziehung As Integer, gezogen As Integer, zaehler4 As Integer
    Dim zaehler1 As Long, zaehler2 As Long, zaehler3 As Long
    Dim Zelle As Range, zelle1 As Range
    Range("A1:E5").Interior.ColorIndex = xlNone
    Range("H1") = ""
    zaehler1 = 1
    endeindex = 75
    ReDim zuzahl(75) As Integer
    For allezahlen = 1 To 75
        zuzahl(allezahlen) = allezahlen
    Next allezahlen
    For ziehung = 1 To 25
        gezogen = Int(Rnd * endeindex) + 1
        zahl(ziehung) = zuzahl(gezogen)
        zuzahl(gezogen) = zuzahl(endeindex)
        endeindex = endeindex - 1
        ReDim Preserve zuzahl(endeindex)
      zaehler2 = zaehler2 + 1
      If zaehler2 = 6 Then
     zaehler1 = zaehler1 + 1
      zaehler2 = 1
      End If
      Cells(zaehler1, zaehler2) = zahl(ziehung)
    Next ziehung
    ReDim zuzahl(75) As Integer
    For allezahlen = 1 To 75
        zuzahl(allezahlen) = allezahlen
    Next allezahlen
    For ziehung = 1 To 5
        gezogen = Int(Rnd * endeindex) + 1
        zahl(ziehung) = zuzahl(gezogen)
        zuzahl(gezogen) = zuzahl(endeindex)
        endeindex = endeindex - 1
        zaehler3 = zaehler3 + 1
        ReDim Preserve zuzahl(endeindex)
        Cells(zaehler3, 7) = zahl(ziehung)
    Next ziehung
    For Each Zelle In Range("A1:E5")
     For Each zelle1 In Range("G1:G5")
        If Cells(Zelle.Row, Zelle.Column) = Cells(zelle1.Row, zelle1.Column) Then
         Cells(Zelle.Row, Zelle.Column).Interior.ColorIndex = 3
        End If
     Next zelle1
    Next Zelle
    For zaehler4 = 1 To 5
    If Cells(zaehler4, 1).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 2).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 3).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 4).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
    If Cells(1, zaehler4).Interior.ColorIndex = 3 _
     And Cells(2, zaehler4).Interior.ColorIndex = 3 _
     And Cells(3, zaehler4).Interior.ColorIndex = 3 _
     And Cells(4, zaehler4).Interior.ColorIndex = 3 _
     And Cells(5, zaehler4).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
  Next zaehler4
 If Cells(1, 1).Interior.ColorIndex = 3 _
     And Cells(2, 2).Interior.ColorIndex = 3 _
     And Cells(3, 3).Interior.ColorIndex = 3 _
     And Cells(4, 4).Interior.ColorIndex = 3 _
     And Cells(5, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
    If Cells(5, 1).Interior.ColorIndex = 3 _
     And Cells(4, 2).Interior.ColorIndex = 3 _
     And Cells(3, 3).Interior.ColorIndex = 3 _
     And Cells(2, 4).Interior.ColorIndex = 3 _
     And Cells(1, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
End Sub

Answer 2

Hallo Adde

ops hatte deinen Namen falsch geschrieben!

Gruß Nighty

Answer 3

Hallo Adde

Hatte noch was übersehen,korrigiert!

Zahlen 1-75 im Code einfach zu aendern

Gruß Nighty

Option Explicit
Sub Bingo()
    Randomize Timer
    Dim zahl(25) As Integer, endeindex As Integer, allezahlen As Integer, ziehung As Integer, gezogen As Integer, zaehler4 As Integer
    Dim zaehler1 As Long, zaehler2 As Long, zaehler3 As Long
    Dim Zelle As Range, zelle1 As Range
    Range("A1:E5").Interior.ColorIndex = xlNone
    Range("H1") = ""
    zaehler1 = 1
    endeindex = 75
    ReDim zuzahl(75) As Integer
    For allezahlen = 1 To 75
        zuzahl(allezahlen) = allezahlen
    Next allezahlen
    For ziehung = 1 To 25
        gezogen = Int(Rnd * endeindex) + 1
        zahl(ziehung) = zuzahl(gezogen)
        zuzahl(gezogen) = zuzahl(endeindex)
        endeindex = endeindex - 1
        ReDim Preserve zuzahl(endeindex)
      zaehler2 = zaehler2 + 1
      If zaehler2 = 6 Then
     zaehler1 = zaehler1 + 1
      zaehler2 = 1
      End If
      Cells(zaehler1, zaehler2) = zahl(ziehung)
    Next ziehung
    ReDim zuzahl(75) As Integer
    endeindex = 75
    For allezahlen = 1 To 75
        zuzahl(allezahlen) = allezahlen
    Next allezahlen
    For ziehung = 1 To 5
        gezogen = Int(Rnd * endeindex) + 1
        zahl(ziehung) = zuzahl(gezogen)
        zuzahl(gezogen) = zuzahl(endeindex)
        endeindex = endeindex - 1
        zaehler3 = zaehler3 + 1
        ReDim Preserve zuzahl(endeindex)
        Cells(zaehler3, 7) = zahl(ziehung)
    Next ziehung
    For Each Zelle In Range("A1:E5")
     For Each zelle1 In Range("G1:G5")
        If Cells(Zelle.Row, Zelle.Column) = Cells(zelle1.Row, zelle1.Column) Then
         Cells(Zelle.Row, Zelle.Column).Interior.ColorIndex = 3
        End If
     Next zelle1
    Next Zelle
    For zaehler4 = 1 To 5
    If Cells(zaehler4, 1).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 2).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 3).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 4).Interior.ColorIndex = 3 _
     And Cells(zaehler4, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
    If Cells(1, zaehler4).Interior.ColorIndex = 3 _
     And Cells(2, zaehler4).Interior.ColorIndex = 3 _
     And Cells(3, zaehler4).Interior.ColorIndex = 3 _
     And Cells(4, zaehler4).Interior.ColorIndex = 3 _
     And Cells(5, zaehler4).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
  Next zaehler4
 If Cells(1, 1).Interior.ColorIndex = 3 _
     And Cells(2, 2).Interior.ColorIndex = 3 _
     And Cells(3, 3).Interior.ColorIndex = 3 _
     And Cells(4, 4).Interior.ColorIndex = 3 _
     And Cells(5, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
    If Cells(5, 1).Interior.ColorIndex = 3 _
     And Cells(4, 2).Interior.ColorIndex = 3 _
     And Cells(3, 3).Interior.ColorIndex = 3 _
     And Cells(2, 4).Interior.ColorIndex = 3 _
     And Cells(1, 5).Interior.ColorIndex = 3 Then
     Cells(1, 8) = "Sieg"
    End If
End Sub

Answer 4

Hall Nigthy

vorab erst einmal vielen Dank für die Mühe die du dir gemacht hast werde es erst morgen ausprobieren und dann ein Feedback geben

Gruß Adde

Answer 5

Wunderschönen Guten Morgen Nigthy und an das Forum,

habe das VBA integriert es funktioniert. Doch nicht ganz so wie ich es gedacht hatte. Dafü möchte ich mich von ganzem Herzen bedanken. Tolle Leistung

Vorab möchte ich noch erwähnen, dass ich 21 Bingo-Felder habe, in denen auch neue Zahlen eingetragen werden sollten. Wobei hier immer die Mitte der Felder leer bleiben müsste. Beginnend mit Zelle H4 bis L8 Spalte leer dann N4 bis R4 wieder Spalte leer dann T4 bis X4 danach zwei Zeilen leer und dann H11 bis L15 und das wiederholt sich bis das 21te Bingo - Feld erreicht ist.

Beispiel: 1tes Feld Zellen B4 bis F8 und D6 leer. beim 2tem Feld P6 usw.

Das VBA 

Die Zahlen werden in den Zellen a1 bis E5 angezeigt um das zu ändern müsste ich doch Range( A1:E5) in "B4:F8" ändern? Habe ich probiert , doch das haut nicht hin. Für Hilfe würde ich mich jetzt schon bedanken.

Vielleicht willst du die Datei anschauen. Die VBA `S sind nicht von mir erstellet, da ich so gut wie keinen Schimmer davon habe. Ist Vieren frei.

Gruß Adde 

PS: Felder sollten nicht farblich markiert sein.

Answer 6

Hallo Adde

Schick mir eine Musterdatei,mit detaillierter Aufgabenstellung!

oberley@t-online.de mit aussagefähigen Betreff.

Gruß Nighty

Answer 7

Hallo Adde

Nebenbei bemerkt kannte ich Bingo nur vom Namen.

Bei einem Testlauf von 2 000 000 durchläufen hatte ich kein einziges mal gewonnen!

Allerdings gibt es auch Varschiedene Varianten mit weniger Zahlen

Gruß Nighty

Answer 8

Vielen Dank für deine Rückmeldung.

Habe dir per Mail schon eine Liste geschickt . Solltest dir eventuell die Datei die ich hochgeladen habe auch anschauen.

Wichtig für die Eintragung Ist die Datei“ In Register Spieler“. Hier sollte die Zahlen, die Gelb sind in den Zellen die Grün gefärbt sind B4 bis F8, erscheinen. Bei deinem Vorschlag erscheinen sie von A1 bis E5.

Und ab Zelle H4 bis L8 usw. sollten auch neue Zahlen eingepflegt werden. Hier kann ich die Zahlen aber über eine = Forrmel aus dem Register Bingokarten Drucken holen. 

Datei ist folgendermaßen aufgebaut:

Register Ziehungen: wird bei Spiele starten angeklickt und die Zahlen werden angesagt und automatisch im unterem Feld markiert. Will man das Spiel unterbrechen klickt man auf Bitte hier klicken.

Im Register Spieler werden die gezogenen Zahlen markiert.

Im Register Bingokarten Drucken sollen dann die generierten Zahlen von Spieler übernommen werden.

=_xlfn._xlws.FILTER(_xlfn.SORTBY(Ziehungen!B9:B23;Ziehungen!D9:D23;-1);Ziehungen!D9:D23>10)

Ich verstehe die Formel nicht und weis daher nicht was in diesen Feldern erscheint. Daher habe ich mir unter Bingokarten drucken ein Zufallsbereich für neue Zahlen erstellt. Diese kann ich dann in den Zellen H4 bis L8 Usw. mit ='Bingokarten Drucken'!H3 übernehmen.

wichtig ist, das habe ich vergessen zu erwähnen, dass die Bingozahlen sich erst ändern, wenn ein Spiel beendet ist.

Oder man baut ein Befehl ein Bingozahlen ändern.

https://filehorst.de/d/dcifzuja

Gruß Adde