ビンゴゲームを作成する:Excel VBA入門

ランダムな数字を作成することを利用して、ビンゴゲームを作成してみたいと思います。
デザインはいたってシンプルなものです。

スポンサードリンク

ビンゴカードを作成する	抽選番号を作成する
抽選番号をカードと照合する	リーチやビンゴを判定する

はじめに　　　Topへ

ここで作成するビンゴゲームは5×5の25マスのものです。
左の列から　1～15、16～30、31～45、46～60、61～75の5個の数字を選ぶようにしています。
中央のマスは「Free」として、最初から選択済みとしています。
作成するビンゴカードは4枚としています。
リーチ、ビンゴ時にはシートに表示します。
カードの作成、抽選番号の作成、番号の照会の3つのプログラムを使っています。
下図が作成したビンゴゲームの画面です。
39回目の抽選でビンゴが成立した時のものです。
乱数の発生には　Excel VBA入門：重複しないランダムな数値を得る方法　【コードの例C】数値の範囲と個数を指定する　を利用しています。

ビンゴカードを作成する　　　 Topへ

作成するカードの数は4枚としています。
変数　k　で1～4回ループして作成しています。
ここで作成するビンゴゲームは5×5の25マスのもので、1～75の数字を表示するものです。
左の列から　1～15、16～30、31～45、46～60、61～75の5個の数字を選ぶようにしています。
各列で取り出した数値は配列　d(i, 1) に格納して、順次　5列分の配列d2(i, j)に格納するようにしています。
シートへは配列　d2(i, j)　の値を入力しています。

Sub card_haifu()
'カード配布
Dim i As Long, j As Long, k As Long
Dim x()
Dim y()
Dim d, d2(1 To 5, 1 To 5)
Dim ld, ud, pd
Dim cd(1 To 4) As String

　　’---カードの位置を指定する
　　cd(1) = "B2": cd(2) = "I2": cd(3) = "B9": cd(4) = "I9"
　　'---シートのクリア、抽選番号の表示などをクリア
　　Worksheets("Sheet2").Range("B:E").ClearContents
　　Worksheets("Sheet1").Range("B:M").Interior.ColorIndex = xlNone
　　Worksheets("Sheet1").Range("A1").Value = 0
　　Worksheets("Sheet1").Range("A2").Value = ""
　　Worksheets("Sheet1").Range("C1,E1,J1,L1,C8,E8,J8,L8").Value = ""

　　With Worksheets("Sheet1")
　　　　For k = 1 To 4　　’カードの枚数
　　　　　　For j = 1 To 5　　'列ごとに乱数を取り出す
　　　　　　　　'---乱数の開始値Ldと終了値Udを指定
　　　　　　　　ld = 1 + (j - 1) * 15 　　'----開始値
　　　　　　　　ud = 15 * j 　　'----終了値
　　　　　　　　pd = 5 　　'----取り出す個数
　　　　　　　　'----使用する配列を準備する(1列分)
　　　　　　　　ReDim x(1 To ud - ld + 1)
　　　　　　　　ReDim y(1 To ud - ld + 1)
　　　　　　　　ReDim d(1 To ud - ld + 1, 1 To 1)
　　　　　　　　Randomize
　　　　　　　　'----乱数と値を配列にセットする
　　　　　　　　For i = 1 To ud - ld + 1
　　　　　　　　　　x(i) = Rnd()
　　　　　　　　　　y(i) = i + ld - 1
　　　　　　　　Next i
　　　　　　　　'----値を取り出す(1列分の5個の数値)
　　　　　　　　For i = 1 To ud - ld + 1
　　　　　　　　　　d(i, 1) = y(Application.Match(Application.Small(x, i), x, 0))
　　　　　　　　Next i
　　　　　　　　'----カード1枚分の数値を配列に収める
　　　　　　　　For i = 1 To 5
　　　　　　　　　　d2(i, j) = d(i, 1)
　　　　　　　　Next i
　　　　　　Next j
　　　　　　'----シートにカードを書き出す
　　　　　　.Range(cd(k)).Resize(5, 5).Value = d2
　　　　　　.Range(cd(k)).Offset(2, 2).Value = "Free"　'中央を「Free」とする
　　　　　　.Range(cd(k)).Offset(2, 2).Interior.ColorIndex = 6　　'中央を黄色で塗りつぶす

　　　　Next k
　　End With
End Sub

【実行結果】

フォームのボタン「カード配布」にマクロ　「card_haifu」を登録して、実行した画面です。
セルの幅や高さ、フォントサイズはシートの方で設定しています。

下のコードは1～20の整数から10個をランダムの取り出す例です。
このコードを1～15、16～30、31～45、46～60、61～75の5個を取り出すように改変しています。
つまり、カード1枚の1列分の数値を作成するための基のコードになります。
これの開始値と終了値を変えながら、5回繰り返すことでカード1枚分の数値が作成できます。

Sub rnsuu03()
　　Dim i As Long
　　Dim x()
　　Dim y()
　　Dim d
　　'---開始値Ldと終了値Udを定数で指定
　　Const Ld = 1　　　'----開始値
　　Const Ud = 20　　'----終了値
　　Const Pd = 10　　'----取り出す個数
　　'----使用する配列を準備する
　　ReDim x(1 To Ud - Ld + 1)
　　ReDim y(1 To Ud - Ld + 1)
　　ReDim d(1 To Ud - Ld + 1, 1 To 1)
　　Randomize
　　　　'----乱数と値を配列にセットする
　　　　For i = 1 To Ud - Ld + 1
　　　　　　x(i) = Rnd()
　　　　　　y(i) = i + Ld - 1
　　　　Next i
　　　　'----値を取り出す
　　　　For i = 1 To Ud - Ld + 1
　　　　　　d(i, 1) = y(Application.Match(Application.Small(x, i), x, 0))
　　　　Next i
　　　　Range("C:C").ClearContents　　　
　　　　For i = 1 To Pd
　　　　　　Range("C" & i).Value = d(i, 1)
　　　　Next i
End Sub

抽選番号を作成する　　　 Topへ

抽選番号1～75を作成して、これをランダムに並べ替えたものをシート2に表示します。
これを「ゲーム開始」のコードで順番に取り出します。

Sub card02()
　　'抽選番号を作成する
　　Dim i As Long, j As Long
　　Dim x()
　　Dim y()
　　Dim d
　　'---開始値Ldと終了値Udを定数で指定
　　Const ld = 1
　　Const ud = 75
　　'----使用する配列を準備する
　　ReDim x(1 To ud - ld + 1)
　　ReDim y(1 To ud - ld + 1)
　　ReDim d(1 To ud - ld + 1, 1 To 1)
　　Randomize

　　With Worksheets("Sheet2")
　　　　.Range("G:G").ClearContents
　　　　'----乱数と値を配列にセットする
　　　　For i = 1 To ud - ld + 1
　　　　　　x(i) = Rnd()
　　　　　　y(i) = i + ld - 1
　　　　Next i
　　　　'----値を取り出す
　　　　For i = 1 To 75
　　　　　　d(i, 1) = y(Application.Match(Application.Small(x, i), x, 0))
　　　　Next i
　　　　.Cells(1, 7).Resize(UBound(d), 1) = d
　　End With
End Sub

実行結果
Sheet2のG列に書き出しています。下図は途中の画像です。

抽選番号をカードと照合する　　　 Topへ

抽選番号とカードの数値を照合して、一致したら黄色に塗りつぶします。
このコードの最後で、次項のリーチとビンゴの判定のマクロ　card_Ceck　を実行しています。

Sub card03()
　　'番号を照会する
　　Dim i As Long, j As Long, k As Long
　　Dim cd(1 To 4) As String
　　'----ビンゴカードの左上の位置を指定しています
　　cd(1) = "B2": cd(2) = "I2": cd(3) = "B9": cd(4) = "I9"

　　With Worksheets("Sheet1")
　　　　.Range("A1").Value = .Range("A1").Value + 1
　　　　.Range("A2").Value = Worksheets("Sheet2").Range("G" & .Range("A1").Value).Value

　　　　For k = 1 To 4
　　　　　　For i = 1 To 5
　　　　　　　　For j = 1 To 5
　　　　　　　　　　If .Range(cd(k)).Offset(i - 1, j - 1).Value = .Range("A2").Value Then
　　　　　　　　　　　　.Range(cd(k)).Offset(i - 1, j - 1).Interior.ColorIndex = 6
　　　　　　　　　　End If
　　　　　　　　Next j
　　　　　　Next i
　　　　Next k
　　End With
　　card_Ceck
End Sub

実行状況
フォームのボタン「ゲーム開始」にマクロ　card03　を登録して実行した画面です。
下図は6回ほどボタンをクリックした画面です。抽選番号と一致した数字のセルを黄色で塗りつぶしています。

リーチやビンゴを判定する　　　 Topへ

リーチやビンゴの時に画面表示して知らせてくれるようにしています。
ビンゴ時には　Beep音を出して知らせるようにしています。

Sub card_Ceck()
　　'カードCheck
　　Dim i As Long, j As Long, k As Long
　　Dim cn1 As Integer, cn2 As Integer, cn3 As Integer, cn4 As Integer
　　Dim cd(1 To 4) As String, ce(1 To 4) As String, cf(1 To 4) As String
　　Dim y()
　　Dim d
　　　　'----カードの位置とリーチ、ビンゴの表示位置
　　　　cd(1) = "B2": cd(2) = "I2": cd(3) = "B9": cd(4) = "I9"
　　　　ce(1) = "C1": ce(2) = "J1": ce(3) = "C8": ce(4) = "J8"
　　　　cf(1) = "E1": cf(2) = "L1": cf(3) = "E8": cf(4) = "L8"
　　　　'---縦と横方向のチェック
　　　With Worksheets("Sheet1")
　　　　　For k = 1 To 4
　　　　　　　cn1 = 0: cn2 = 0: cn3 = 0: cn4 = 0
　　　　　　　For i = 1 To 5
　　　　　　　　　For j = 1 To 5
　　　　　　　　　　　If .Range(cd(k)).Offset(i - 1, j - 1).Interior.ColorIndex = 6 Then
　　　　　　　　　　　　　cn1 = cn1 + 1
　　　　　　　　　　　End If

　　　　　　　　　　　If .Range(cd(k)).Offset(j - 1, i - 1).Interior.ColorIndex = 6 Then
　　　　　　　　　　　　　cn2 = cn2 + 1
　　　　　　　　　　　End If
　　　　　　　　　Next j
　　　　　　　　　’----リーチとビンゴの判定
　　　　　　　　　If cn1 = 4 Or cn2 = 4 Then
　　　　　　　　　　　.Range(ce(k)).Value = "リーチ"
　　　　　　　　　End If
　　　　　　　　　If cn1 = 5 Or cn2 = 5 Then
　　　　　　　　　　　.Range(cf(k)).Value = "BINGO!!"
　　　　　　　　　　　Beep
　　　　　　　　　End If
　　　　　　　　　cn1 = 0: cn2 = 0
　　　　　　　Next i
　　　　'----斜め方向をチェック
　　　　For i = 1 To 5
　　　　　　If .Range(cd(k)).Offset(i - 1, i - 1).Interior.ColorIndex = 6 Then
　　　　　　　　cn3 = cn3 + 1
　　　　　　End If
　　　　　　If .Range(cd(k)).Offset(i - 1, 5 - i).Interior.ColorIndex = 6 Then
　　　　　　　　cn4 = cn4 + 1
　　　　　　End If
　　　　Next i
　　　　’----リーチとビンゴの判定
　　　　If cn3 = 4 Or cn4 = 4 Then
　　　　　　.Range(ce(k)).Value = "リーチ"
　　　　End If
　　　　If cn3 = 5 Or cn4 = 5 Then
　　　　　　.Range(cf(k)).Value = "BINGO!!"
　　　　　　Beep
　　　　End If
　　　　cn3 = 0: cn4 = 0

　　　Next k

　End With
End Sub

実行画面
[ゲーム開始]ボタンで抽選とカードの照合を実行して、リーチ後ビンゴになった時の画面です。
30回目の「3」で1のカードでビンゴになった時のようすです。

スポンサードリンク

よねさんのWordとExcelの小部屋｜Excel(エクセル) VBA入門：目次｜ビンゴゲームを作成する

PageViewCounter
　 Counter
　Since2006/2/27

ビンゴゲームを作成する:Excel VBA入門

はじめに Topへ

ビンゴカードを作成する Topへ

抽選番号を作成する Topへ

抽選番号をカードと照合する Topへ

リーチやビンゴを判定する Topへ

はじめに　　　Topへ

ビンゴカードを作成する　　　 Topへ

抽選番号を作成する　　　 Topへ

抽選番号をカードと照合する　　　 Topへ

リーチやビンゴを判定する　　　 Topへ