Soprani Software

Bald ist es wieder soweit: das SongContest-Spektakel geht über die Bühne – dieses Mal in Schweden! Ein Tipp zur Abendgestaltung: Freunde einladen, und SongContest-Bingo spielen. Das geht so: jeder Teilnehmende bekommt einen Zettel mit Dingen, die beim SongContest passieren können; wenn etwas davon eintrifft, wird’s angekreuzt, und wer als erstes fünf in einer Reihe hat (senkrecht, waagrecht oder diagonal) schreit „BINGO!“. Verkürzt den Abend ungemein, wir haben das letztes Jahr ausprobiert.

Damit auch ausreichend Glück mit im Spiel ist, bekommt natürlich jeder Teilnehmende einen anderen Zettel. Die Fragen dürfen dabei durchaus die gleichen sein, müssen es aber nicht. Ist natürlich mühsam, das vorzubereiten – es sei denn, Sie programmieren ein bisschen was. Viel brauchen Sie dazu nicht herrichten, nur

• einen Bereich mit dem Namen par_Bingo, in dem Sie die möglichen Ereignisse Zelle für Zelle hineinschreiben, und der mindestens so viele Zellen umfasst wie das Bingo-Kärtchen (in meinem Beispiel 5*5)
• eine Zelle mit dem Namen Bingo_Anzahl, die mit der Formel =ANZAHL2(par_Bingo) die verwendeten Zellen im Bereich par_Bingo zählt
• eine Zelle namens Bingo_Zeilen und eine namens Bingo_Spalten, in denen Sie angeben, wie viele Zeilen bzw. Spalten Ihr Bingo umfasst (hier sind beide Werte 5)
• eine Zelle namens Bingo_Teilnehmer, in die Sie schreiben, wie viele Freunde teilnehmen (Sie eingeschlossen)
• ein weiteres Arbeitsblatt mit dem Blattnamen Bingo, in dem Sie das Raster vorbereiten und schon einmal die Druckansicht richtig einstellen. Das wird nämlich jetzt für jeden Teilnehmer kopiert und individuell befüllt.

Jetzt geht’s los. Die Prozedur, die die erforderliche Arbeit für Sie erledigt, ist folgende:

Sub verteilen()
Dim verwendet() As Boolean
Dim I As Long
Dim ShI As Long
Dim BingoSh As Worksheet
Dim Zeile As Long
Dim Spalte As Long
Dim Zufall As Long
Dim Grenzwert As Long
Application.DisplayAlerts = False
For I = ThisWorkbook.Sheets.Count To 1 Step -1
    If Len(ThisWorkbook.Sheets(I).Name) > 5 And Left(ThisWorkbook.Sheets(I).Name, 5) = "Bingo" Then
    ThisWorkbook.Sheets(I).Delete
    End If
Next I
Application.DisplayAlerts = True
Grenzwert = Range("Bingo_Anzahl")
ReDim verwendet(Grenzwert)
Set BingoSh = ThisWorkbook.Sheets("Bingo")
For ShI = 1 To Range("Bingo_Teilnehmer")
    Randomize Timer
    For I = 1 To Grenzwert 
        verwendet(I) = False
    Next I
    For Zeile = 1 To Range("Bingo_Zeilen")
        For Spalte = 1 To Range("Bingo_Spalten")
            Zufall = Int(Rnd() * Grenzwert) + 1
            While verwendet(Zufall)
                Zufall = Int(Rnd() * Grenzwert) + 1
            Wend
            BingoSh.Cells(Zeile, Spalte) = Range("par_Bingo").Cells(Zufall)
            verwendet(Zufall) = True
        Next Spalte
    Next Zeile
    BingoSh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "Bingo" & ShI
Next ShI
Set BingoSh = Nothing
End Sub

Erklärungen dazu:

Mit der ersten For I-Schleife werden bereits bestehende Bingo1, …-Tabellenblätter gelöscht. Damit können Sie den Prozess beliebig oft wiederholen. Wesentlich ist das „Herunterzählen“ beim Löschen – beginnen Sie mit der Zählervariable immer beim letzten Element (Aufzählung.Count) und arbeiten Sie sich mit Step -1 zum Anfang vor, wenn Sie eine Schleife zum Löschen verwenden. Sonst gibt’s Fehler.

Die Array-Variable verwendet wird zunächst als unbestimmtes Array angelegt. Mit ReDim wird das Array dann so groß gemacht, wie es aktuell benötigt wird. Das macht Sie frei in der Wahl der Eingaben in par_Bingo – wenn Ihnen mehr einfällt, müssen Sie nicht alles neu programmieren, sondern nur den Namen richtig setzen.

Die Anzahl der Teilnehmenden bestimmt nun, wie viele Blätter mit der For ShI-Schleife generiert werden sollen. Zunächst wird alles im Beispielblatt Bingo hergerichtet.

Die Einträge im Array verwendet werden auf False gesetzt – es gibt ein Element für jeden Ereignisvorschlag, und wenn ein neues Blatt erzeugt wird, wurde noch kein Element verwendet.

Alle Zeilen und Spalten werden nun befüllt. Das macht die For Zeile-Schleife mit der eingeschlossenen For Spalte-Schleife.

Das Befüllen funktioniert so: Per Zufall wird ein Element bestimmt.  (Int(Rnd()*Grenzwert)+1 liefert eine Zufallszahl zwischen 1 und dem Grenzwert, der die Anzahl der Elemente ist.) Im Array wird geschaut, ob das schon verwendet ist. Solange das der Fall ist (While verwendet(Zufall)), versuchen wir’s mit der nächsten Zufallszahl.

Haben wir endlich ein noch nicht verwendetes Element gefunden, so wird das in die Zelle geschrieben, die gerade „dran ist“, und wir vermerken, dass es verwendet ist und für das aktuelle Blatt nicht mehr zu haben ist.

Wenn alle Zeilen und Spalten befüllt sind, wird das Beispielblatt Bingo unter neuem Namen kopiert. Fertig!

Viel Spaß beim Spielen! Sie können ja alle Shows anschauen und jedes Mal andere Bingoblätter erstellen. Mit der Arbeitsmappe ESC 2016 geht das ja flott 🙂 Und wenn Ihnen die Programmierung eigentlich wurscht ist, spielen Sie trotzdem. Sie können die Prozedur einfach ausführen; ich hab sie mit dem Shortcut Str+Shift+V verlinkt.