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

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

はじめに Topへ

• ×ばつ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の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
Counter
Since2006/2/27