会社のイベントや結婚式の二次会などで幹事になるとイベントや景品の準備が大変ですよね。パーティでビンゴをやるつもりだけど、どんなツールやアプリを使うか迷っている方もいるかと思います。そこで今回はパソコンで簡単にビンゴゲームができるエクセルを作成しました。
クリック１つで簡単に抽選ができるので、ぜひご利用して頂ければと思います。また、簡易的ですが同一エクセルでビンゴカード生成もできるようにしています。
※アルファベットビンゴ版は以下のページ
アルファベットビンゴができるエクセルファイル【ビンゴシート生成可能】
ファイルダウンロード
使用するファイルはこちらになります。
ファイルを開くときに「ウイルスに感染している可能性があります」とメッセージが出ると思いますが特に悪意のあるソフトではないので問題ないです（笑）エクセルマクロを使用しているので、このメッセージが出るのは仕方ないですね。
「編集を有効にする」をクリックして「コンテンツの有効化」をクリックするとプログラムを起動することができます。
使い方
使い方はとても簡単で「抽選開始ボタン」をクリックするだけです。
※ダブルクリックではなく、1クリックでスタートが開始されます。複数回クリックすると連続で抽選が開始されてしまいます。
初期の画面はこのようになっていて、抽選開始ボタンをクリックすると数字の抽選が始まります。
ランダムな数字がいくつか表示された後、抽選数字が確定します。抽選時間は５秒くらいです。
例えば１回目の抽選は「３３」が出ました！
この状態で５秒経つと自動的に抽選数字一覧画面に移ります。
今までどのような数字が抽選されたか確認することができます。
さらに、この状態が５秒表示された後、再び以下の抽選画面に戻ります。
２回目以降も抽選開始ボタンをクリックすれば抽選が開始されます。
ビンゴを最初からやる場合には、ゲームリセットボタンをクリックすれば今までの抽選数字一覧もクリアされます。使い方は難しくないので、ぜひご利用頂ければと思います。
ビンゴカードは100円ショップ等で買うことをおすすめしますが、もしビンゴカードを紙で作成する場合はファイル中の「ビンゴカード」のタブを選択し、「ビンゴカード生成」ボタンをクリックするとランダムでビンゴカードが生成されます。
また、ビンゴの景品で悩まれている方は以下の商品はいかがでしょうか？
景品の参考としてご紹介させて頂きます。
ソースコード
少しマニアックですが、動作している仕組みが知りたいという人のために、VBAのコードを貼っておきます。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub 数字抽選()
Dim i As Integer
Dim temp_num As Integer
Dim count As Integer
Dim flag As Integer
count = Worksheets("抽選数字一覧").Cells(3, 4)
If count = 75 Then
MsgBox "すべての数字が選出されました"
Exit Sub
End If
書式リセット
'----------------抽選を演出----------------
For i = 1 To 10
DoEvents
Sleep 200
Worksheets("抽選機").Cells(1, 1) = Int(Rnd() * 75 + 1)
Next
For i = 1 To 5
DoEvents
Sleep 500
Worksheets("抽選機").Cells(1, 1) = Int(Rnd() * 75 + 1)
Next
For i = 1 To 3
DoEvents
Sleep 700
Worksheets("抽選機").Cells(1, 1) = Int(Rnd() * 75 + 1)
Next
'-------------------------------------------
Do While 1
DoEvents
temp_num = Int(Rnd() * 75 + 1)
flag = 1 '乱数生成成功フラグを立てる
For i = 1 To 75
If temp_num = Worksheets("抽選数字一覧").Cells(i, 1) Then
flag = 0 '乱数生成失敗
End If
Next
If flag = 1 Then
Exit Do
End If
Loop
Worksheets("抽選機").Cells(1, 1) = temp_num
Sleep 1000
確定演出
Worksheets("抽選数字一覧").Cells(4, 4) = Worksheets("抽選機").Cells(1, 1)
抽選数字一覧書き込み
DoEvents
Sleep 5000
Sheets("閲覧用抽選数字").Select
抽選数字一覧色塗り
DoEvents
Sleep 5000
Sheets("抽選機").Select
End Sub
Sub 抽選数字一覧書き込み()
Dim i As Integer
Dim counter As Integer
count = Worksheets("抽選数字一覧").Cells(3, 4)
Worksheets("抽選数字一覧").Cells(count + 1, 1) = Worksheets("抽選数字一覧").Cells(4, 4)
End Sub
Sub 抽選数字一覧色塗り()
Dim i As Integer
Dim num As Integer
Dim j As Integer
Dim k As Integer
num = Worksheets("抽選数字一覧").Cells(4, 4)
j = (num - 1) \ 15
k = (num - 1) Mod 15
Cells(j + 1, k + 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -52429
.TintAndShade = 0
End With
End Sub
Sub ゲームリセット()
Dim i As Integer
For i = 1 To 75
Worksheets("抽選数字一覧").Cells(i, 1) = ""
Worksheets("抽選数字一覧").Cells(4, 4) = ""
Next
Sheets("閲覧用抽選数字").Select
Range("A1:O5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
Sheets("抽選機").Select
Range("A1").Select
End Sub
Sub ビンゴカード生成()
Dim temp_num(5) As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim check_flag As Integer
For i = 0 To 4 '1列目から5列目に対して実行
Do While 1 '数字が決定するまで続ける
For j = 1 To 5
temp_num(j) = Int(Rnd() * 15 + 1 + (15 * i)) '乱数を代入
Next
check_flag = 1 '成功フラグを立てておく
For j = 1 To 4
For k = j + 1 To 5
If temp_num(j) = temp_num(k) Then
check_flag = 0 '同じ数字が失敗フラグにする
End If
Next
Next
If check_flag = 1 Then '成功フラグならwhile文を抜ける
Exit Do
End If
Loop
Worksheets("ビンゴカード").Cells(2, 2 + i) = temp_num(1)
Worksheets("ビンゴカード").Cells(3, 2 + i) = temp_num(2)
Worksheets("ビンゴカード").Cells(4, 2 + i) = temp_num(3)
Worksheets("ビンゴカード").Cells(5, 2 + i) = temp_num(4)
Worksheets("ビンゴカード").Cells(6, 2 + i) = temp_num(5)
Next
Worksheets("ビンゴカード").Cells(4, 4) = "Free"
End Sub
Sub 確定演出()
Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -52429
.TintAndShade = 0
End With
End Sub
Sub 書式リセット()
Range("A1").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
End Sub
コメント
コメント一覧 （3件）
クリスマス会でビンゴをしたくて、利用させていただきます。ビンゴの雰囲気が出せて凄く嬉しいです。何回かおきにスタートボタンを押さないのに勝手にスタートしてしまいます。こちらで修正する方法はありますでしょうか？教えていただけると幸いです。
ご利用頂きありがとうございます。勝手にスタートしてしまうということですが、スタートさせるときに「抽選開始ボタン」をダブルクリックされていないでしょうか？ダブルクリックすると2回連続でスタートされてしまいます。「抽選開始ボタン」は1クリックでスタートするので、まずはその点をご確認頂ければと思います。
マウスではなくタッチパッドでクリックしたらちゃんとできました！！早速のお返事ありがとうございました。