1. Home » 
2. Excel VBA入門：目次 » 
3. ビンゴゲームを作成する

ビンゴゲームを作成する: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のカードでビンゴになった時のようすです。
    

スポンサードリンク

PageViewCounter
　
　Since2006/2/27