ExcelのVBAでミニゲーム“マインスイーパ”を作成する

読者がWindowsにあるマインスイーパを遊んだことがあると思いますが、Excelのvbaでマインスイーパゲームを開発できますか？答えはできます。

インターフェイス

Win7バージョンより前のマインスイープには、難易度(初級、中級、上級)が調整できます。難易度によって、範囲はそれぞれ99、1616、16*30に分け、地雷の数はそれぞれ10、40、99です。カスタマイズをサポートします。ゲームの基本的な操作は、左クリック、右クリック、左ボタンと右ボタンを同時に押します。Excelの制限により、これらの操作はマウスですべて操作できません。

Excelワークシートにある類似のイベントは、Worksheet_SelectionChange、Worksheet_BeforeRightClick、Worksheet_BeforeDoubleClickです。ただし、最後の2つのイベントがトリガーされる前に最初のイベントをトリガーするのは残念なので、上記の図のように3つの操作をボタンに置きます。

生成された地雷と各セルのステータスを格納するために、最初に2つの「メモリ」範囲が必要です。そのため、Sheet1とSheet2が必要で、Sheet3がゲームのインターフェイスとして使用されます。必要なインターフェイスは、列幅が2、等幅フォント、太字、すべてのセルを罫線付き、太い外枠を設定します。

各セルにある異なる数値を異なる色に設定します。各セルを操作する場合、Cellオブジェクトは非常に複雑であるため、実行速度に確実に影響されます。ここでは、条件付き書式設定方法を使用し、セル範囲に値を割り当てた後、自動的に色を変更します。著者が設定したルールは次のとおりです。

インターフェイスのスタイルは手動で設定することも、マクロを記録してコードを取得し、ゲームの初期化メソッドを使用してインターフェイスのサイズに応じて自動的に設定することもできます。コードは次のように表示されます。

Private Sub Game_Interface_Init(ByVal r As Integer, ByVal c As Integer)

Sheet3.UsedRange.Clear
Sheet3.Range(Cells(1, 1), Cells(r, c)).Select
With Selection
  .ColumnWidth = 2
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  .BorderAround Weight:=xlMedium
  
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=1").Font.Color = RGB(0, 112, 192)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=2").Font.Color = RGB(0, 176, 80)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=3").Font.Color = RGB(192, 0, 0)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=4").Font.Color = RGB(0, 32, 96)
  .Interior.ColorIndex = 15
End With

Sheet3.Cells(1, 1).Select
End Sub

もちろん、記録されたコードはそれほど簡潔にすることはできません。

初期状態

中級の難易度を例として、ゲームを作成します。

Public mineArr  '地雷の配列：0は地雷がないことを意味し、9は地雷があることを意味し、その他は周囲の地雷の数を意味します
Public statusArr  '状態配列：0はマークされていない、1は雷としてマークされて、2は？としてマークされて、3は開いているを意味します
Public dr, dc  '行列の変換

Public Sub Medium()

Call Game_Init(16, 16, 40)
Call Game_Interface_Init(16, 16)

End Sub

最初にゲームを初期化し、次にゲームのインターフェイスを初期化します。ゲームを初期化するとき、16*16の配列でランダムに40個の地雷を生成し、地雷が生成されるたびに、周囲の有効セルの値は+1です。生成が完了すると、地雷の配列はSheet1に配置し、状態配列をSheet2に配置し、ゲームの状態を進行中としてマークします（Tは進行中、Fは終了を意味します）。 コードは次のように表示されます。

Private Sub Game_Init(ByVal r As Integer, ByVal c As Integer, ByVal n As Integer)
'r,c はそれぞれ行、列、地雷の数を表す

ReDim mineArr(1 To r, 1 To c) As Integer
ReDim statusArr(1 To r, 1 To c) As Integer

Dim dr, dc  '行列の変換
dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)

Dim x%, y%, k%, sum% 'x,y はそれぞれ水平座標と垂直座標を表す

Randomize (Timer)
Do

  k = Int(r * c * Rnd())
  x = Int(k / c) + 1
  y = k Mod c + 1
    
  If mineArr(x, y) <> 9 Then
    Call Mine_Add(x, y, r, c)
    sum = sum + 1
  End If
  
Loop While (sum < n)

Sheet1.Activate
Sheet1.UsedRange.ClearContents
Sheet1.Range(Cells(1, 1), Cells(r, c)) = mineArr

Sheet2.Activate
Sheet2.UsedRange.ClearContents
Sheet2.Range(Cells(1, 1), Cells(r, c)) = statusArr

Sheet3.Activate
Sheet3.Range("zz1") = "T"

End Sub

ここでのr、cは行と列の数、x、yは水平と垂直座標、m、nは変更された水平と垂直座標であると設定します。

ここでのループでは、コードの最初の3行は、古典的な1次元から2次元になるアルゴリズムであり、これも前に説明しました。次には判定です。地雷がないところに地雷を1つだけ追加します。地雷を増やすためのMine_Addメソッドは次のとおりです。

Private Sub Mine_Add(ByVal x As Integer, ByVal y As Integer, ByVal r As Integer, ByVal c As Integer)

mineArr(x, y) = 9
Dim m%, n%  'm,n は変更された水平と垂直座標を意味する
For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If mineArr(m, n) <> 9 Then mineArr(m, n) = mineArr(m, n) + 1
  End If
Next i

End Sub

ここでは、以前に定義したパブリック変数の行と列の変換補助配列を使用して地雷を追加します。0から7のループで元の座標に基づいて座標を変更し、地雷の位置の周りの8つのセルをトラバースします。もちろん、最初に有効性を判断してから、地雷ではないセルの周りにあるセルの値に1を加える必要があります。セルの有効性判定コードは次のとおりです。

Private Function Cell_Effective(ByVal m As Integer, ByVal n As Integer) As Boolean

Cell_Effective = False
r = UBound(statusArr)
c = UBound(statusArr, 2)

If m >= 1 And m <= r And n >= 1 And n <= c Then Cell_Effective = True

End Function

ゲームの操作

ゲームの操作には、左クリック、右クリック、左ボタンと右ボタンを同時にクリック、3つが含まれます。対応する効果は次のとおりです。

左クリック：セルを開き、0の場合、隣接する正方形を再帰的に開きます。1〜8の場合は、このセルのみを開きます。9の場合は、鉱山に接触し、ゲームが終了します。

右クリック：1回クリックして地雷としてマークし、もう一度クリックして疑問符としてマークし、またもう一度クリックしてマークをクリアします。

ダブルクリック：周囲でマークされた地雷が番号と同じである場合は、他の開いていないセルを左クリックします。

左クリック

3つの操作をExcelの3つのメソッドに書き込みます。これらのメソッドは、セルを選択した後にボタンをクリックして呼び出されます。 ダブルクリックは左クリックメソッドを呼び出す必要があるため、左クリックイベントをボタン呼び出しメソッドから分離します。 コードは次のように表示されます。

Public Sub Left_Click()

If Sheet3.Range("zz1") = "F" Then Exit Sub
x = ActiveCell.Row
y = ActiveCell.Column

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange

Call Left_Click_Event(x, y)
Call Game_Win()

End Sub


Private Sub Left_Click_Event(ByVal x As Integer, ByVal y As Integer)

Dim r%, c%
r = UBound(statusArr)
c = UBound(statusArr, 2)
If Cell_Effective(x, y) = False Then Exit Sub

dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)
numlist = Array(-c - 1, -c, -c + 1, -1, 1, c - 1, c, c + 1)

If mineArr(x, y) = 9 Then
  Call Game_Over(x, y)
  Exit Sub
ElseIf mineArr(x, y) > 0 Then
  Call Open_Cell(x, y)
Else
  
  Dim checkList, checkedList
  Set checkList = CreateObject("Scripting.Dictionary")
  Set checkedList = CreateObject("Scripting.Dictionary")
  checkList.Add (x - 1) * c + (y - 1), 1
  
  Do While (checkList.Count > 0)
    
    Dim key, a%, b%
    For Each key In checkList
      a = Int(key / c) + 1
      b = key Mod c + 1
      
      Call Open_Cell(a, b)
      checkList.Remove (key)
      checkedList.Add key, 1
      
      For i = 0 To 7
        Dim m%, n%
        m = a + dr(i)
        n = b + dc(i)
        If Cell_Effective(m, n) Then
          If statusArr(m, n) = 0 And checkList.Exists(key + numlist(i)) = False And checkedList.Exists(key + numlist(i)) = False Then
            If mineArr(m, n) = 0 Then
              checkList.Add key + numlist(i), 1
            Else
              checkedList.Add key + numlist(i), 1
              Call Open_Cell(m, n)
            End If
          End If
        End If
      Next i
      
    Next
  Loop
  
End If

End Sub

左ボタンをクリックすると、最初にゲームの状態が進行中であるかどうかを判断し、次に座標を取得して左クリックイベントをトリガーします。イベントが終わったら、ゲームに勝ったかどうかを判定します。コードは次のとおりです。

Private Sub Game_Win()

Application.ScreenUpdating = False
Sheet2.Activate
Sheet2.UsedRange = statusArr
Sheet3.Activate
Application.ScreenUpdating = True

r = UBound(statusArr)
c = UBound(statusArr, 2)
For i = 1 To r
  For j = 1 To c
    If mineArr(i, j) = 9 And statusArr(i, j) <> 2 Then Exit Sub
    If mineArr(i, j) < 9 And statusArr(i, j) <> 3 Then Exit Sub
  Next j
Next i

Sheet3.Range("zz1") = "F"
MsgBox "勝った！", , "勝った"

End Sub

ゲームが勝ったかどうかを判定する方法では、最初に変更された状態配列をSheet2の「メモリ」範囲に格納し、次に配列をトラバースして判断します。 すべての地雷が見つかり、他のすべてのエリアをクリックすると、ゲームが終了で、勝ったと判定されます。

左クリックイベントが開始され、最初に「メモリ」から地雷原配列と状態配列が読み取られ、次に行と列の数が計算され、前に作成したCell_Effective関数を使用して、選択されたセルが有効かどうかが判定されます。次に、条件分岐を入力します。

条件1：座標が地雷であれば、Game_Overメソッドが呼び出され、ゲームが終了します。コードは次のように表示されます。

Private Sub Game_Over(ByVal x As Integer, ByVal y As Integer)
Application.ScreenUpdating = True
ActiveCell.Interior.ColorIndex = 3

r = UBound(mineArr)
c = UBound(mineArr, 2)

For i = 1 To r
  For j = 1 To c
    If mineArr(i, j) = 9 And statusArr(i, j) <> 1 Then Sheet3.Cells(i, j) = "●"
    If mineArr(i, j) <> 9 And statusArr(i, j) = 1 Then Sheet3.Cells(i, j) = "×": Sheet3.Cells(i, j).Font.ColorIndex = 1
  Next j
Next i

Sheet3.Range("zz1") = "F"
MsgBox "ゲームが終了！", , "ゲームが終了"

End Function

ゲームを終了するには、最初にクリックしされた地雷のセルを赤の背景色に変更し、次に配列を使用してすべてのマークされていない地雷を見つけ、次に誤ってマークされたセルを×に変更します。

条件2：座標が数値の場合、Open_Cellメソッドを呼び出してセルを開きます。 コードは次のように表示されます。

Private Sub Open_Cell(ByVal x As Integer, ByVal y As Integer)

statusArr(x, y) = 3
Sheet3.Cells(x, y).Interior.ColorIndex = 0
Sheet3.Cells(x, y).Value = mineArr(x, y)

End Sub

セルを開くには、状態配列を3としてマークしてから、背景色を白に変更し、地雷の配列の数値をセルに割り当てます。

条件３：座標が空の場合、周囲のセルを再帰的に開きます。ここでは、自動インクリメントアルゴリズムが使用されています。

チェックされた（checkedList）とチェックされていない（checkList）の2つのリストを作成し、チェックされていないリストに要素がある場合はループを続けます。座標セルを最初に配置し、周囲の有効なセルをトラバースします。セルが0の場合は、チェックされていないセルに配置し、保留状態になります。セルが数値の場合は、チェックされたセルに配置して、セルを開きます。最後に、セルを開いてチェックリストに入れます。

このアルゴリズムはより複雑で、多くのループがネストされています。アルゴリズムコードを個別に説明します。

  Dim checkList, checkedList
  Set checkList = CreateObject("Scripting.Dictionary")
  Set checkedList = CreateObject("Scripting.Dictionary")
  checkList.Add (x - 1) * c + (y - 1), 1
  
  Do While (checkList.Count > 0)
    
    Dim key, a%, b%
    For Each key In checkList
      a = Int(key / c) + 1
      b = key Mod c + 1
      
      Call Open_Cell(a, b)
      checkList.Remove (key)
      checkedList.Add key, 1
      
      For i = 0 To 7
        Dim m%, n%
        m = a + dr(i)
        n = b + dc(i)
        If Cell_Effective(m, n) Then
          If statusArr(m, n) = 0 And checkList.Exists(key + numlist(i)) = False And checkedList.Exists(key + numlist(i)) = False Then
            If mineArr(m, n) = 0 Then
              checkList.Add key + numlist(i), 1
            Else
              checkedList.Add key + numlist(i), 1
              Call Open_Cell(m, n)
            End If
          End If
        End If
      Next i
      
    Next
  Loop

まず、辞書オブジェクトをチェックされたとチェックされていないストレージツールとして使用し（Existsメソッドは後で使用するため）、次にセルインデックスをKeyと呼ばれ、1をItemとして辞書に配置します。 Do Loopループによって、条件は、チェックされていない辞書の要素の数量が0より大きい場合です。ループでは、チェックされていない辞書をFor Eachでトラバースし、インデックスであるKeyによって、一時セルの座標aとbを計算します。次に、Open_Cellメソッドを呼び出してセルを開き、同時にチェックされていないからKeyを削除して、チェックされたに追加します。

次に、前と同じ方法を使用して、周囲の8つのセルをトラバースし、a、bから一時座標m、nを計算し、Cell_Effectiveを使用してセルが有効範囲にあることを確認し、同時に3つの条件を満たす必要があります。開いていない、チェックされたとチェックされていない辞書にありません。このようなセルは、空白セルの場合はチェックされていないに追加し、数値の場合はチェックされたに追加し、開きます。

右クリック

右クリックして地雷をマークします。コードは次のとおりです。

Public Sub Right_Click()
If Sheet3.Range("zz1") = "F" Then Exit Sub

x = ActiveCell.Row
y = ActiveCell.Column

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange
r = UBound(statusArr)
c = UBound(statusArr, 2)
If Cell_Effective(x, y) = False Then Exit Sub

If statusArr(x, y) <> 3 Then
  statusArr(x, y) = (statusArr(x, y) + 1) Mod 3
  
  Select Case statusArr(x, y)
    Case 0
      Sheet3.Cells(x, y) = ""
      Sheet3.Cells(x, y).Font.ColorIndex = 1
    Case 1
      Sheet3.Cells(x, y) = "★"
      Sheet3.Cells(x, y).Font.ColorIndex = 3
    Case 2
      Sheet3.Cells(x, y) = "？"
      Sheet3.Cells(x, y).Font.ColorIndex = 1
  End Select
End If

Call Game_Win
End Sub

開いていない有効なセルでは、右クリックすると、状態配列の値が0、1、2の間でループし、それぞれマークなし、地雷としてマーク、疑問符としてマークに対応します。終了後、ゲームが勝ったかどうかを確認します。

ダブルクリック

ダブルクリックの実現も比較的簡単です。まず、周囲のマークされた地雷の数を計算します。値がセルの値と同じである場合は、周囲の有効なセルをトラバースし、周囲の地雷としてマークされていないセルに左クリックイベントを実行します。

Public Sub Chording()
If Sheet3.Range("zz1") = "F" Then Exit Sub
If ActiveCell.Value = 0 Then Exit Sub

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange
x = ActiveCell.Row
y = ActiveCell.Column
dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)

Dim sum%
sum = 0

For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If statusArr(m, n) = 1 Then sum = sum + 1
  End If
Next i

If sum < ActiveCell.Value Then Exit Sub
For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If mineArr(m, n) = 9 And statusArr(m, n) <> 1 Then
      Call Game_Over(m, n)
      Exit Sub
    End If
    If mineArr(m, n) <> 9 And statusArr(m, n) = 1 Then
      Call Game_Over(m, n)
      Exit Sub
    End If
  End If
Next i

For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If statusArr(m, n) <> 1 Then Call Left_Click_Event(m, n)
  End If
Next i

Call Game_Win
End Sub

周囲のセルを開く場合、事前に判定します。周囲にマークされていない地雷や誤ってマークされた地雷がある場合は、ゲームが終了されます。

ここまで、マインスイーパのコード部分が終わりです。ボタンを挿入して、左、右、ダブルクリックのメソッドや、さまざまな難易度のゲーム初期化メソッドを呼び出すことができます。また、難易度をカスタマイズすることもできます。完全なコードは次の付録にあります。

付録

Public mineArr  '地雷の配列：0は地雷がないことを意味し、9は地雷があることを意味し、その他は周囲の地雷の数を意味します
Public statusArr  '状態配列：0はマークされていない、1は雷としてマークされて、2は？としてマークされて、3は開いていることを意味します
Public dr, dc  '行列の変換

Public Sub Medium()

Call Game_Init(16, 16, 40)
Call Game_Interface_Init(16, 16)

End Sub


Private Sub Game_Interface_Init(ByVal r As Integer, ByVal c As Integer)

Sheet3.UsedRange.Clear
Sheet3.Range(Cells(1, 1), Cells(r, c)).Select
With Selection
  .ColumnWidth = 2
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  .BorderAround Weight:=xlMedium
  
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=1").Font.Color = RGB(0, 112, 192)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=2").Font.Color = RGB(0, 176, 80)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=3").Font.Color = RGB(192, 0, 0)
  .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=4").Font.Color = RGB(0, 32, 96)
  .Interior.ColorIndex = 15
End With

Sheet3.Cells(1, 1).Select
End Sub

Private Sub Game_Init(ByVal r As Integer, ByVal c As Integer, ByVal n As Integer)

'r,c はそれぞれ行、列、地雷の数を表します

ReDim mineArr(1 To r, 1 To c) As Integer
ReDim statusArr(1 To r, 1 To c) As Integer

dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)

Dim x%, y%, k%, sum% 'x,y はそれぞれ水平座標と垂直座標を表します

Randomize (Timer)
Do

  k = Int(r * c * Rnd())
  x = Int(k / c) + 1
  y = k Mod c + 1
    
  If mineArr(x, y) <> 9 Then
    Call Mine_Add(x, y)
    sum = sum + 1
  End If
  
Loop While (sum < n)

Sheet1.Activate
Sheet1.UsedRange.ClearContents
Sheet1.Range(Cells(1, 1), Cells(r, c)) = mineArr

Sheet2.Activate
Sheet2.UsedRange.ClearContents
Sheet2.Range(Cells(1, 1), Cells(r, c)) = statusArr

Sheet3.Activate
Sheet3.Range("zz1") = "T"

End Sub

Private Sub Mine_Add(ByVal x As Integer, ByVal y As Integer)

mineArr(x, y) = 9
Dim m%, n%  'm,nは変更された水平と垂直座標を意味します
For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If mineArr(m, n) <> 9 Then mineArr(m, n) = mineArr(m, n) + 1
  End If
Next i

End Sub

Private Function Cell_Effective(ByVal m As Integer, ByVal n As Integer) As Boolean

Cell_Effective = False
r = UBound(statusArr)
c = UBound(statusArr, 2)

If m >= 1 And m <= r And n >= 1 And n <= c Then Cell_Effective = True

End Function

Public Sub Left_Click()

If Sheet3.Range("zz1") = "F" Then Exit Sub
x = ActiveCell.Row
y = ActiveCell.Column

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange

Call Left_Click_Event(x, y)
Call Game_Win

End Sub

Private Sub Game_Win()

Application.ScreenUpdating = False
Sheet2.Activate
Sheet2.UsedRange = statusArr
Sheet3.Activate
Application.ScreenUpdating = True

r = UBound(statusArr)
c = UBound(statusArr, 2)
For i = 1 To r
  For j = 1 To c
    If mineArr(i, j) = 9 And statusArr(i, j) <> 1 Then Exit Sub
    If mineArr(i, j) < 9 And statusArr(i, j) <> 3 Then Exit Sub
  Next j
Next i

Sheet3.Range("zz1") = "F"
MsgBox "勝った！", , "勝った"

End Sub

Private Sub Left_Click_Event(ByVal x As Integer, ByVal y As Integer)

Dim r%, c%
r = UBound(statusArr)
c = UBound(statusArr, 2)
If Cell_Effective(x, y) = False Then Exit Sub

dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)
numlist = Array(-c - 1, -c, -c + 1, -1, 1, c - 1, c, c + 1)

If mineArr(x, y) = 9 Then
  Call Game_Over(x, y)
  Exit Sub
ElseIf mineArr(x, y) > 0 Then
  Call Open_Cell(x, y)
Else
  
  Dim checkList, checkedList
  Set checkList = CreateObject("Scripting.Dictionary")
  Set checkedList = CreateObject("Scripting.Dictionary")
  checkList.Add (x - 1) * c + (y - 1), 1
  
  Do While (checkList.Count > 0)
    
    Dim key, a%, b%
    For Each key In checkList
      a = Int(key / c) + 1
      b = key Mod c + 1
      
      Call Open_Cell(a, b)
      checkList.Remove (key)
      checkedList.Add key, 1
      
      For i = 0 To 7
        Dim m%, n%
        m = a + dr(i)
        n = b + dc(i)
        If Cell_Effective(m, n) Then
          If statusArr(m, n) = 0 And checkList.Exists(key + numlist(i)) = False And checkedList.Exists(key + numlist(i)) = False Then
            If mineArr(m, n) = 0 Then
              checkList.Add key + numlist(i), 1
            Else
              checkedList.Add key + numlist(i), 1
              Call Open_Cell(m, n)
            End If
          End If
        End If
      Next i
      
      
    Next
  Loop
  
End If

End Sub

Private Sub Open_Cell(ByVal x As Integer, ByVal y As Integer)

statusArr(x, y) = 3
Sheet3.Cells(x, y).Interior.ColorIndex = 0
If mineArr(x, y) <> 0 Then Sheet3.Cells(x, y).Value = mineArr(x, y)

End Sub

Private Sub Game_Over(ByVal x As Integer, ByVal y As Integer)
Application.ScreenUpdating = True

r = UBound(mineArr)
c = UBound(mineArr, 2)

For i = 1 To r
  For j = 1 To c
    If mineArr(i, j) = 9 And statusArr(i, j) <> 1 Then Sheet3.Cells(i, j) = "●"
    If mineArr(i, j) <> 9 And statusArr(i, j) = 1 Then Sheet3.Cells(i, j) = "×": Sheet3.Cells(i, j).Font.ColorIndex = 1
  Next j
Next i

Sheet3.Cells(x, y).Interior.ColorIndex = 3
Sheet3.Range("zz1") = "F"
MsgBox "ゲームが終了！", , "ゲームが終了"

End Sub

Public Sub Right_Click()
If Sheet3.Range("zz1") = "F" Then Exit Sub

x = ActiveCell.Row
y = ActiveCell.Column

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange
r = UBound(statusArr)
c = UBound(statusArr, 2)
If Cell_Effective(x, y) = False Then Exit Sub

If statusArr(x, y) <> 3 Then
  statusArr(x, y) = (statusArr(x, y) + 1) Mod 3
  
  Select Case statusArr(x, y)
    Case 0
      Sheet3.Cells(x, y) = ""
      Sheet3.Cells(x, y).Font.ColorIndex = 1
    Case 1
      Sheet3.Cells(x, y) = "★"
      Sheet3.Cells(x, y).Font.ColorIndex = 3
    Case 2
      Sheet3.Cells(x, y) = "？"
      Sheet3.Cells(x, y).Font.ColorIndex = 1
  End Select
End If

Call Game_Win
End Sub

Public Sub Chording()
If Sheet3.Range("zz1") = "F" Then Exit Sub
If ActiveCell.Value = 0 Then Exit Sub

mineArr = Sheet1.UsedRange
statusArr = Sheet2.UsedRange
x = ActiveCell.Row
y = ActiveCell.Column
dr = Array(-1, -1, -1, 0, 0, 1, 1, 1)
dc = Array(-1, 0, 1, -1, 1, -1, 0, 1)

Dim sum%
sum = 0

For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If statusArr(m, n) = 1 Then sum = sum + 1
  End If
Next i

If sum < ActiveCell.Value Then Exit Sub
For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If mineArr(m, n) = 9 And statusArr(m, n) <> 1 Then
      Call Game_Over(m, n)
      Exit Sub
    End If
    If mineArr(m, n) <> 9 And statusArr(m, n) = 1 Then
      Call Game_Over(m, n)
      Exit Sub
    End If
  End If
Next i

For i = 0 To 7
  m = x + dr(i)
  n = y + dc(i)
  If Cell_Effective(m, n) Then
    If statusArr(m, n) <> 1 Then Call Left_Click_Event(m, n)
  End If
Next i

Call Game_Win
End Sub