Excel でビンゴ

お盆に家族で実家に行くと、孫たちの遊び用にと、幾つかの玩具やゲームが
揃えられていました。その中に100円ショップで購入したビンゴゲームの
カードがあったのですが、抽選(?)用のガラガラ(?)がありません。
娘が「ビンゴしたい!」と私の周りを飛び跳ねるので、実家のPCでExcel VBA
を用いてビンゴ用抽選マクロを作成しました。

見た目は、こんな感じです。

f:id:Infoment:20180812055146p:plain

「次のボール」ボタンを押すたび、1~75の数字が一つ抽選されます。抽選済みの数字は、20行4列の表に順次表示されます。実際はA列に入力されていて、これを参照することにしました。

f:id:Infoment:20180812055539p:plain

※A列は通常、非表示にしてあります。

また、スムーズな進行を目的として、直近の数のみ大きく表示してみました。

f:id:Infoment:20180812055731p:plain

コードは、以下の通りです。
※実際使用される場合、事前に参照設定で「Microsoft Scripting Runtime」にチェックを入れておいてください。
f:id:Infoment:20180812062421p:plain

Option Explicit

Dim Dict As Dictionary
Dim NumberRange As Range

' 抽選用
Sub Bingo()
    Dim i As Long
        If Dict Is Nothing Then
            Set Dict = New Dictionary
        End If
        i = Dict.Count + 1

    Dim MsgboxResult As VbMsgBoxResult
        If i >= 76 Then
            MsgboxResult = MsgBox("最後のボールです。リセットしますか?", vbYesNo)
            If MsgboxResult = vbYes Then
                Call Reset
            End If
            Exit Sub
        End If

    Dim TempNumber As Long
        Do
            TempNumber = GetRandomNumber(1, 75)
            If Dict.Exists(TempNumber) = False Then
                Dict(TempNumber) = i
                Exit Do
            End If
        Loop

        Cells(i, "A") = TempNumber
        Cells(1, "J") = TempNumber
End Sub

' 乱数による抽選
Public Function GetRandomNumber(min_number As Long, max_number As Long) As Long
    Dim temp As Long
        Do
            temp = Rnd * (max_number + 1)
            If temp >= min_number And temp <= max_number Then
                Exit Do
            End If
        Loop        
        GetRandomNumber = temp
End Function

'リセットボタン
Sub Reset()
    If Not Dict Is Nothing Then
        If Dict.Count < 75 Then
            Dim MsgboxResult As VbMsgBoxResult
                MsgboxResult = MsgBox("まだ途中ですがリセットしますか?", vbYesNo)
                If MsgboxResult = vbNo Then
                    Exit Sub
                End If
        End If
    End If

    Set Dict = New Dictionary
    Set NumberRange = Range("A1:A75")
        NumberRange = ""
        Cells(1, "J") = ""
End Sub

ビンゴ用シートには、ボタン用のマクロを作成します。

Option Explicit

'「次のボール」ボタン
Private Sub CommandButton1_Click()
    Call Bingo
End Sub

' 「リセット」ボタン
Private Sub CommandButton2_Click()
    Dim MsgboxResult As VbMsgBoxResult
        MsgboxResult = MsgBox("リセットしてもよいですか?", vbYesNo)
        If MsgboxResult = vbYes Then
            Call Reset
        End If
End Sub

ボタンは今回、ActiveXコントロールのCommadButtonを使用しました。

f:id:Infoment:20180812063257p:plain

一つずつ順次配置すれば、上記の名前で配置されるはずです。


今回は抽選の結果が重複しないよう、辞書(連想配列)を用いました。辞書にないもの、つまり

Dict.Exists(ランダムに発生させた番号)= False

になるまで作成した数を破棄して、繰り返し乱数を発生させます。重複しない数字を得たら辞書に登録して、次の抽選に備えるわけです。

乱数は、Rnd関数を使用しています。もともとは 0 ~ 1 の間の数をランダムに発生させる関数なので、これに最大値を掛けることで、希望する範囲の数を、ランダムに得ることが出来るわけです。

ただし実際、今回は0~76までの数を発生させています。

temp = Rnd * (max_number + 1)

75までだと、「75.18281828459041…」のように75より大きな数の端数を除いた「75」が抽選される機会がなくなり、結果、75が出にくくなるのでは?と考えたからです。単なる素人の思いつきなので、厳密には間違っているのかもしれません(気分的なものです)。

即席のビンゴにしては、娘も喜んでくれたので、良かったかな?と思います。

参考まで。