VBAでオセロ作成 #4コレクションから配列使用に変更、8方向ひっくり返し判定
以前はコレクションにオセロの盤面の石の配置の情報を格納していたのですが、コレクションの特性で一度格納したデータを更新するのが困難だったので配列を使用する方法へ変更しました。配列に変更することでデータの取り扱い方が解りやすくなりひっくり返す判定も作りやすかったです。
※注意この時点のコードではひっくり返し判定が動作がおかしな点がありますが、#5の記事にて改修していますのでそのままお進みください。
Public stone_arr(8, 8) As String 'グローバル配列として宣言します
```
まず複数のプロシージャで盤面情報が格納された配列内のデータをやり取りするのでパブリックで配列を宣言しています。
````vb
Sub cell_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cell_click_row As Integer 'ダブルクリックしたセル行
Dim cell_click_column As Integer 'ダブルクリックしたセル列
cell_click_row = Target.Row '選択した行を代入
cell_click_column = Target.Column '選択した列を代入
'盤上か判定
If cell_click_row >= 3 And 10 >= cell_click_row And cell_click_column >= 3 And 10 >= cell_click_column Then
'セル内編集モードのキャンセル
Cancel = True
'石が既にあるかの判定
If Cells(cell_click_row, cell_click_column).Value = "" Then
'フォントサイズ指定
Cells(2, 1).Font.Size = 36
'変数stoneがBLACK_STONEだったら●を置く、WHITE_STONEだったら◯を置く
If stone = BLACK_STONE Then
Cells(Target.Row, Target.Column).Value = BLACK_STONE
ElseIf stone = WHITE_STONE Then
Cells(Target.Row, Target.Column).Value = WHITE_STONE
End If
'盤面情報保存する
Call Stone_Map
'8方向にひっくり返す判定
Call Stone_Reverse_Right(Target) '右ひっくり返す判定
Call Stone_Reverse_Left(Target) '左ひっくり返す判定
Call Stone_Reverse_Up(Target) '上ひっくり返す判定
Call Stone_Reverse_Down(Target) '下ひっくり返す判定
Call Stone_Reverse_UpRight(Target) '右上ひっくり返す判定
Call Stone_Reverse_UpLeft(Target) '左上ひっくり返す判定
Call Stone_Reverse_DownRight(Target) '右下ひっくり返す判定
Call Stone_Reverse_DownLeft(Target) '左下ひっくり返す判定
'配列データを盤面に反映
Call ApplyArrayData
'手数をカウントアップ
stone_count = stone_count + 1
If stone_count Mod 2 = 1 Then
'置き終わったら「黒の番です」と表示
Cells(2, 1) = "「黒の番です」"
'奇数の場合
stone = BLACK_STONE
reverse_stone = WHITE_STONE
Else
'偶数の場合
'置き終わったら「白の番です」と表示
Cells(2, 1) = "「白の番です」"
stone = WHITE_STONE
reverse_stone = BLACK_STONE
End If
Else
MsgBox "既に石が置かれています。"
End If
Else
MsgBox "盤上ではありません。"
End If
End Sub
```
ダブルクリックして石を置いたらStone_Mapプロシージャで盤面の状況を取得し、8方向ひっくり返し判定の関数を呼び出して
配列内の盤面を更新した後、実際のセルに配列の盤面状況を反映させてひっくり返しています。
```vb
Function Stone_Map() '盤面情報保存関数
Dim i As Integer 'For文用rowカウンタ
Dim j As Integer 'For文用columnカウンタ
i = 0 'rowカウンタ初期化
j = 0 'columnカウンタ初期化
'盤面情報を配列に保存
For i = 0 To 7
For j = 0 To 7
stone_arr(i, j) = Cells(i + 3, j + 3)
Next
Next
End Function
```
盤面情報を配列内に格納していく関数です。For分をネストして盤面に見立てた二次元配列に白黒どちらの石があるかを格納してます。
```vb
'////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////右方向ひっくり返す関数/////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////////////
Function Stone_Reverse_Right(ByVal Target As Range)
Dim i As Integer '反対の色の石探索用のカウンタ
i = 0
Dim a_row, a_col As Integer '座標変換用変数
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
Dim r As Integer 'ひっくり返す用カウンタ
If 3 <= Target.Column And Target.Column <= 8 Then '選択セルの列がエクセル上の座標で3~8の間だったら
Do While 0 < a_col + i < 7 '左右端を除いた範囲で繰り返す
CONTINUE: '反対色の石が続いた時の戻る用ラベル
i = i + 1 '反対の色の石探索用のカウンタ変数インクリメント
If stone_arr(a_row, a_col + i) = reverse_stone Then '一つ右の石が反対色の石か?
If stone_arr(a_row, a_col + i + 1) = stone Then 'さらにもう一つ右の石が同じ色か?
r = a_col + i 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While r > a_col '石置いた列までひっくり返しループ
If stone = BLACK_STONE Then '置いた石が黒石だったら
stone_arr(a_row, r) = BLACK_STONE '一個前の配列データを●にひっくり返す
ElseIf stone = WHITE_STONE Then '置いた石が白石だったら
stone_arr(a_row, r) = WHITE_STONE '一個前の配列データを◯にひっくり返す
End If
r = r - 1 'ひっくり返す用カウンタ変数をデクリメント(置いた位置まで戻る)
Loop
ElseIf stone_arr(a_row, a_col + i + 1) = reverse_stone Then
GoTo CONTINUE
End If
End If
Exit Do '最初のループ抜ける
Loop
End If
End Function
```
右方向のひっくり返す判定です。
最初に石がひっくり返す判定が必要な場所に置かれたかを判断してからひっくり返す必要がある範囲でループして
配列内で石をひっくり返して行きます。
```vb
'*************************************************************************************
'******************************左方向ひっくり返す関数*********************************
'*************************************************************************************
Function Stone_Reverse_Left(ByVal Target As Range)
Dim i As Integer '反対の色の石探索用のカウンタ
i = 0
Dim a_row, a_col As Integer '座標変換用変数
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
Dim r As Integer 'ひっくり返す用カウンタ
If 5 <= Target.Column And Target.Column <= 10 Then '選択セルの行が5~10の間だったら(左ひっくり返す判定が必要な位置)
Do While 0 < a_col + i < 7 '左右端を除いた位置の間繰り返す
CONTINUE: '反対色の石が続いた時の戻る用ラベル
i = i + 1 '反対の色の石探索用のカウンタ変数インクリメント
If stone_arr(a_row, a_col - i) = reverse_stone Then '配列内の一つ左の石が反対色の石か?
If stone_arr(a_row, a_col - i - 1) = stone Then '配列内のさらにもう一つ左の石が同じ色か?
r = a_col - i 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While r < a_col '石置いた位置までひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(a_row, r) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(a_row, r) = WHITE_STONE '一個前を◯にひっくり返す
End If
r = r + 1 'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)
Loop
ElseIf stone_arr(a_row, a_col - i - 1) = reverse_stone Then 'さらにもう一つ左の石が反対色だったらiインクリメントまでスキップ
GoTo CONTINUE
End If
End If
Exit Do '最初のループ抜ける
Loop
End If
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++上方向ひっくり返す関数++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function Stone_Reverse_Up(ByVal Target As Range)
Dim i As Integer '反対の色の石探索用のカウンタ
i = 0
Dim a_row, a_col As Integer '座標変換用変数
Dim r As Integer 'ひっくり返す用カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If 5 <= Target.Row And Target.Row <= 10 Then '選択セルの列が5~10の間だったら(上ひっくり判定が必要な位置に石を置いたか)
Do While 0 < a_row + i < 7 '上下端を除いた位置の間で繰り返す
CONTINUE: '反対色の石が続いた時の戻る用ラベル
i = i + 1 '反対の色の石探索用のカウンタ変数インクリメント
If stone_arr(a_row - i, a_col) = reverse_stone Then '一つ上の石が反対色の石か?
If stone_arr(a_row - i - 1, a_col) = stone Then 'さらにもう一つ上の石が同じ色か?
r = a_row - i 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While r < a_row 'ひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(r, a_col) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(r, a_col) = WHITE_STONE '一個前を◯にひっくり返す
End If
r = r + 1 'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)
Loop
ElseIf stone_arr(a_row - i - 1, a_col) = reverse_stone Then 'もう一つ上の石が反対色だったらiインクリメントまでスキップ
GoTo CONTINUE
End If
End If
Exit Do '最初のループ抜ける
Loop
End If
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@下方向ひっくり返す判定@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function Stone_Reverse_Down(ByVal Target As Range)
Dim i As Integer 'x軸方向のカウンタ
i = 0
Dim a_row, a_col As Integer '座標変換用変数
Dim r As Integer 'ひっくり返す用カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If 3 <= Target.Row And Target.Row <= 8 Then '選択セルの列が3~8の間だったら(下ひっくり判定が必要な位置に石を置いたか)
Do While 0 < a_row + i < 7 'ひっくり返し判定を繰り返す範囲
CONTINUE: '反対色の石が続いた時の戻る用ラベル
i = i + 1 '反対の色の石探索用のカウンタ変数インクリメント
If stone_arr(a_row + i, a_col) = reverse_stone Then '一つ下の石が反対色の石か?
If stone_arr(a_row + i + 1, a_col) = stone Then 'さらにもう一つ下の石が同じ色か?(ひっくり返し終端か?)
r = a_row + i 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While r > a_row 'ひっくり返しループ ※a_row(置いた石の行)より下の位置の間だけ繰り返す
If stone = BLACK_STONE Then
stone_arr(r, a_col) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(r, a_col) = WHITE_STONE '一個前を◯にひっくり返す
End If
r = r - 1 'ひっくり返す用カウンタ変数をデクリメント(上に戻っていく)
Loop
ElseIf stone_arr(a_row + i + 1, a_col) = reverse_stone Then 'もう一つ下の石が反対色だったらiインクリメントまでスキップ
GoTo CONTINUE
End If
End If
Exit Do '最初のループ抜ける
Loop
End If
End Function
'--------------------------------------------------------------------------
'-----------------------右上方向ひっくり返す関数---------------------------
'--------------------------------------------------------------------------
Function Stone_Reverse_UpRight(ByVal Target As Range)
Dim x As Integer '反対の色の石探索x軸方向用のカウンタ
x = 1
Dim y As Integer '反対の色の石探索y軸方向用のカウンタ
y = 1
Dim a_row, a_col As Integer '座標変換用変数
Dim rx As Integer 'ひっくり返す用x軸カウンタ
Dim ry As Integer 'ひっくり返す用y軸カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If (5 <= Target.Row And Target.Row <= 10) And (3 <= Target.Column And Target.Column <= 8) Then '選択セルの行が5~10且つ列が3~8だったら(右上ひっくり判定が必要な位置に石を置いたか)
Do While (0 < a_row + y < 7) And (0 < a_col + x < 7) '上下左右端を除いた位置の間で繰り返す
If stone_arr(a_row - y, a_col + x) = "" Then '一つ右上に石がなかったら?
Exit Do 'ひっくり返しループ抜ける
End If
If stone_arr(a_row - y, a_col + x) = reverse_stone Then '一つ右上の石が置いた石と反対色の石か?
If stone_arr(a_row - y - 1, a_col + x + 1) = stone Then 'さらにもう一つ右上の石が置いた石と同じ色か?(ひっくり判定終端か?)
rx = a_col + x 'ひっくり返す用カウンタに一個前の列座標を入れる
ry = a_row - y 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While (ry < a_row) And (rx > a_col) 'ひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(ry, rx) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(ry, rx) = WHITE_STONE '一個前を◯にひっくり返す
End If
rx = rx - 1 'ひっくり返す用カウンタ変数をインクリメント(左に戻っていく)
ry = ry + 1 'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)
Loop
End If
End If
x = x + 1 '反対の色の石探索用のx軸カウンタ変数インクリメント
y = y + 1 '反対の色の石探索用のy軸カウンタ変数インクリメント
Loop
End If
End Function
'--------------------------------------------------------------------------
'-----------------------右上方向ひっくり返す関数---------------------------
'--------------------------------------------------------------------------
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\左上方向ひっくり返す関数\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Function Stone_Reverse_UpLeft(ByVal Target As Range)
Dim x As Integer '反対の色の石探索x軸方向用のカウンタ
x = 1
Dim y As Integer '反対の色の石探索y軸方向用のカウンタ
y = 1
Dim a_row, a_col As Integer '座標変換用変数
Dim rx As Integer 'ひっくり返す用x軸カウンタ
Dim ry As Integer 'ひっくり返す用y軸カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If (5 <= Target.Row And Target.Row <= 10) And (5 <= Target.Column And Target.Column <= 10) Then '選択セルの行が5~10且つ列が5~10だったら(右上ひっくり判定が必要な位置に石を置いたか)
Do While (0 < a_row + y < 7) And (0 < a_col + x < 7) '上下左右端を除いた位置の間で繰り返す
If stone_arr(a_row - y, a_col - x) = "" Then '一つ左上に石がなかったら?
Exit Do 'ひっくり返しループ抜ける
End If
If stone_arr(a_row - y, a_col - x) = reverse_stone Then '一つ左上の石が置いた石と反対色の石か?
If stone_arr(a_row - y - 1, a_col - x - 1) = stone Then 'さらにもう一つ左上の石が置いた石と同じ色か?(ひっくり判定終端か?)
rx = a_col - x 'ひっくり返す用カウンタに一個前の列座標を入れる
ry = a_row - y 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While (ry < a_row) And (rx < a_col) 'ひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(ry, rx) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(ry, rx) = WHITE_STONE '一個前を◯にひっくり返す
End If
rx = rx + 1 'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)
ry = ry + 1 'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)
Loop
End If
End If
x = x + 1 '反対の色の石探索用のx軸カウンタ変数インクリメント
y = y + 1 '反対の色の石探索用のy軸カウンタ変数インクリメント
Loop
End If
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\左上方向ひっくり返す関数\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'##############################################################################################
'####################################右下方向ひっくり返す関数##################################
'##############################################################################################
Function Stone_Reverse_DownRight(ByVal Target As Range)
Dim x As Integer '反対の色の石探索x軸方向用のカウンタ
x = 1
Dim y As Integer '反対の色の石探索y軸方向用のカウンタ
y = 1
Dim a_row, a_col As Integer '座標変換用変数
Dim rx As Integer 'ひっくり返す用x軸カウンタ
Dim ry As Integer 'ひっくり返す用y軸カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If (3 <= Target.Row And Target.Row <= 8) And (3 <= Target.Column And Target.Column <= 8) Then '選択セルの行が3~8且つ列が3~8だったら(右上ひっくり判定が必要な位置に石を置いたか)
Do While (0 < a_row + y < 7) And (0 < a_col + x < 7) '上下左右端を除いた位置の間で繰り返す
If stone_arr(a_row + y, a_col + x) = "" Then '一つ右下に石がなかったら?
Exit Do 'ひっくり返しループ抜ける
End If
If stone_arr(a_row + y, a_col + x) = reverse_stone Then '一つ右上の石が置いた石と反対色の石か?
If stone_arr(a_row + y + 1, a_col + x + 1) = stone Then 'さらにもう一つ右上の石が置いた石と同じ色か?(ひっくり判定終端か?)
rx = a_col + x 'ひっくり返す用カウンタに一個前の列座標を入れる
ry = a_row + y 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While (ry > a_row) And (rx > a_col) 'ひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(ry, rx) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(ry, rx) = WHITE_STONE '一個前を◯にひっくり返す
End If
rx = rx - 1 'ひっくり返す用カウンタ変数をインクリメント(左に戻っていく)
ry = ry - 1 'ひっくり返す用カウンタ変数をインクリメント(上に戻っていく)
Loop
End If
End If
x = x + 1 '反対の色の石探索用のx軸カウンタ変数インクリメント
y = y + 1 '反対の色の石探索用のy軸カウンタ変数インクリメント
Loop
End If
End Function
'##############################################################################################
'####################################右下方向ひっくり返す関数##################################
'##############################################################################################
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@左下方向ひっくり返す関数
Function Stone_Reverse_DownLeft(ByVal Target As Range)
Dim x As Integer '反対の色の石探索x軸方向用のカウンタ
x = 1
Dim y As Integer '反対の色の石探索y軸方向用のカウンタ
y = 1
Dim a_row, a_col As Integer '座標変換用変数
Dim rx As Integer 'ひっくり返す用x軸カウンタ
Dim ry As Integer 'ひっくり返す用y軸カウンタ
a_row = Target.Row - 3 '選択セルの行を配列上の座標に変換して代入
a_col = Target.Column - 3 '選択セルの列を配列上の座標に変換して代入
If (3 <= Target.Row And Target.Row <= 8) And (5 <= Target.Column And Target.Column <= 10) Then '選択セルの行が3~8且つ列が3~8だったら(右上ひっくり判定が必要な位置に石を置いたか)
Do While (0 < a_row + y < 7) And (0 < a_col + x < 7) '上下左右端を除いた位置の間で繰り返す
If stone_arr(a_row + y, a_col - x) = "" Then '一つ左下に石がなかったら?
Exit Do 'ひっくり返しループ抜ける
End If
If stone_arr(a_row + y, a_col - x) = reverse_stone Then '一つ左下の石が置いた石と反対色の石か?
If stone_arr(a_row + y + 1, a_col - x - 1) = stone Then 'さらにもう一つ左下の石が置いた石と同じ色か?(ひっくり判定終端か?)
rx = a_col - x 'ひっくり返す用カウンタに一個前の列座標を入れる
ry = a_row + y 'ひっくり返す用カウンタに一個前の列座標を入れる
Do While (ry > a_row) And (rx < a_col) 'ひっくり返しループ
If stone = BLACK_STONE Then
stone_arr(ry, rx) = BLACK_STONE '一個前を●にひっくり返す
ElseIf stone = WHITE_STONE Then
stone_arr(ry, rx) = WHITE_STONE '一個前を◯にひっくり返す
End If
rx = rx + 1 'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)
ry = ry - 1 'ひっくり返す用カウンタ変数をインクリメント(上に戻っていく)
Loop
End If
End If
x = x + 1 '反対の色の石探索用のx軸カウンタ変数インクリメント
y = y + 1 '反対の色の石探索用のy軸カウンタ変数インクリメント
Loop
End If
End Function
```
斜め方向は2つカウンタを使ってループさせてなんとかひっくり返すことが出来ました。
```vb
Function ApplyArrayData() '配列データを盤面に反映させる関数
Dim i As Integer 'For文用rowカウンタ
Dim j As Integer 'For文用columnカウンタ
i = 0 'rowカウンタ初期化
j = 0 'columnカウンタ初期化
For i = 0 To 7
For j = 0 To 7
Cells(i + 3, j + 3) = stone_arr(i, j)
Next
Next
End Function
```
最初に盤面情報を取得した関数の逆バージョンで配列の中の盤面情報をExcelのセルへ反映させてます。
# まとめ
前回投稿から大分時間が経ってしまいましたがなんとかひっくり返す所まで完成しました。
あとはまだひっくり返せない・ひっくり返す意思がない場所に石を置けてしまうのでひっくり返すことが可能な場所だけに石を置けるようにしたいです。それとパスできるようにするのと石を数えて勝利判定を実装くらいでしょうか。
中々難しそうですが頑張って完成目指します。