【ビンゴゲームを作る】
**************************************************
Excel で ビンゴゲーム作ってみました。
今回はフォームではなく、シート上で作りました。
外観
最初は一つだけ作りましたが、
「ビンゴは一人でやるもんじゃないな」と思ったので、３つしました。
各カードにチェックボックスのみを配置して１枚でも遊べるようにしました。
チェックボックスに文字は入れず、チェックボックスのみ使用しています。
チェックボックスに記述した文字列は大きさを変更できないので。
マクロ
今回は、特に説明することもないので、
えいっ！
丸投げだ！！
・
・
・
と思ったのですが、やっぱりいつも通り分けます。
モジュールレベル変数
Dim Bingo1Range As Range 'Bingo1のカードのエリア
Dim Bingo2Range As Range 'Bingo2のカードのエリア
Dim Bingo3Range As Range 'Bingo3のカードのエリア
カードの番号初期化
Sub InitializeField()
'各シートの数字を初期化します
Dim r As Long '行番号を格納します
Dim c As Long '列番号を格納します
Dim BingoNum As Long '抽選で当たった数字を格納します
Set Bingo1Range = Range(Cells(2, 2), Cells(6, 6))
Set Bingo2Range = Range(Cells(2, 10), Cells(6, 14))
Set Bingo3Range = Range(Cells(2, 18), Cells(6, 22))
Call Reset 'リセットのプロシージャを呼び出します
'*** Bingo1 のカードの数字を設定します*********************
If Range("H1") = True Then 'Bingo1のチェックマークが入っていたら
For r = 2 To 6
For c = 2 To 6
Do 'カード上に入力する数字を重複しないよう設定します
BingoNum = Int(Rnd * 50) + 1 '1-50の乱数を発生させます
If c = 4 And r = 4 Then '中央のフリーは無視します
Exit Do
End If
'出た数字がカード上に既にあるかチェックする
If Bingo1Range.Find(BingoNum) Is Nothing Then
Cells(r, c) = BingoNum '無ければ入力する
Exit Do
End If
Loop
Next c
Next r
End If
'*** Bingo2 *********************
If Range("P1") = True Then
For r = 2 To 6
For c = 10 To 14
Do
BingoNum = Int(Rnd * 50) + 1
If c = 12 And r = 4 Then
Exit Do
End If
If Bingo2Range.Find(BingoNum) Is Nothing Then
Cells(r, c) = BingoNum
Exit Do
End If
Loop
Next c
Next r
End If
'*** Bingo3 *********************
If Range("X1") = True Then
For r = 2 To 6
For c = 18 To 22
Do
BingoNum = Int(Rnd * 50) + 1
If c = 20 And r = 4 Then
Exit Do
End If
If Bingo3Range.Find(BingoNum) Is Nothing Then
Cells(r, c) = BingoNum
Exit Do
End If
Loop
Next c
Next r
End If
End Sub
リセット
Sub Reset()
Set Bingo1Range = Range(Cells(2, 2), Cells(6, 6))
Set Bingo2Range = Range(Cells(2, 10), Cells(6, 14))
Set Bingo3Range = Range(Cells(2, 18), Cells(6, 22))
'カード上の全てのセル背景色を塗りつぶし無しにします
Bingo1Range.Interior.ColorIndex = xlAutomatic
Bingo2Range.Interior.ColorIndex = xlAutomatic
Bingo3Range.Interior.ColorIndex = xlAutomatic
'中央の「Free」のセルに指定の色を付け直します
Range("D4").Interior.Color = RGB(255, 217, 102)
Range("L4").Interior.Color = RGB(255, 217, 102)
Range("T4").Interior.Color = RGB(255, 217, 102)
'抽選で出た数字と「Bingo」の文字を削除します
Range("E9") = ""
Range("B8") = ""
Range("J8") = ""
Range("R8") = ""
End Sub
*************************************************
うーん・・・
もしかしたら、Range と For Each を使えば、もっと簡単にかけたのかなぁ・・・
調べてみよう。
こういうとこが、まだまだ初心者なんでしょうねぇ。
／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿
個人用マクロブックについてはこちら
リボンに登録についてはこちら
＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／
