会社のイベントや結婚式の二次会などで幹事になるとイベントや景品の準備が大変ですよね。パーティでビンゴをやるつもりだけど、どんなツールやアプリを使うか迷っている方もいるかと思います。そこで今回はパソコンで簡単にビンゴゲームができるエクセルを作成しました。
クリック１つで簡単に抽選ができるので、ぜひご利用して頂ければと思います。また、簡易的ですが同一エクセルでビンゴカード生成もできるようにしています。
※アルファベットビンゴ版は以下のページ
アルファベットビンゴができるエクセルファイル【ビンゴシート生成可能】
スポンサーリンク
ファイルダウンロード
使用するファイルはこちらになります。
ファイルを開くときに「ウイルスに感染している可能性があります」とメッセージが出ると思いますが特に悪意のあるソフトではないので問題ないです（笑）エクセルマクロを使用しているので、このメッセージが出るのは仕方ないですね。
「編集を有効にする」をクリックして「コンテンツの有効化」をクリックするとプログラムを起動することができます。
使い方
使い方はとても簡単で「抽選開始ボタン」をクリックするだけです。
※ダブルクリックではなく、1クリックでスタートが開始されます。複数回クリックすると連続で抽選が開始されてしまいます。
初期の画面はこのようになっていて、抽選開始ボタンをクリックすると数字の抽選が始まります。
ランダムな数字がいくつか表示された後、抽選数字が確定します。抽選時間は５秒くらいです。
例えば１回目の抽選は「３３」が出ました！
この状態で５秒経つと自動的に抽選数字一覧画面に移ります。
今までどのような数字が抽選されたか確認することができます。
さらに、この状態が５秒表示された後、再び以下の抽選画面に戻ります。
２回目以降も抽選開始ボタンをクリックすれば抽選が開始されます。
ビンゴを最初からやる場合には、ゲームリセットボタンをクリックすれば今までの抽選数字一覧もクリアされます。使い方は難しくないので、ぜひご利用頂ければと思います。
ビンゴカードは100円ショップ等で買うことをおすすめしますが、もしビンゴカードを紙で作成する場合はファイル中の「ビンゴカード」のタブを選択し、「ビンゴカード生成」ボタンをクリックするとランダムでビンゴカードが生成されます。
また、ビンゴの景品で悩まれている方は以下の商品はいかがでしょうか？
景品の参考としてご紹介させて頂きます。
景品 ディズニーペアチケット 目録・パネル付 送料無料・あす楽 結婚式二次会景品・ビンゴ景品・イベント景品・パーティー景品・忘年会・ ディズニーランド ディズニーシー用 ディズニーチケット 内容：東京ディズニーペアチケット 日付指定なし 1dayパスポート
created by Rinker
¥14,800
(2024/04/20 00:49:54時点 楽天市場調べ-詳細)
created by Rinker
¥8,980
(2024/04/20 00:49:54時点 楽天市場調べ-詳細)
【新モデル】Nintendo Switch 本体【Joy-Con(L) ネオンブルー/(R) ネオンレッド】 任天堂 [HAD-S-KABAA NSWホンタイネオン シンモデル]【送料無料】
ソースコード
少しマニアックですが、動作している仕組みが知りたいという人のために、VBAのコードを貼っておきます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 |
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 |
スポンサーリンク