VBAでオセロ作成 #4コレクションから配列使用に変更、8方向ひっくり返し判定
以前はコレクションにオセロの盤面の石の配置の情報を格納していたのですが、コレクションの特性で一度格納したデータを更新するのが困難だったので配列を使用する方法へ変更しました。配列に変更することでデータの取り扱い方が解りやすくなりひっくり返す判定も作りやすかったです。
Publicstone_chart(8,8)まず複数のプロシージャで盤面情報が格納された配列内のデータをやり取りするのでパブリックで配列を宣言しています。
Subcell_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)Dimcell_click_rowAsInteger'ダブルクリックしたセル行Dimcell_click_columnAsInteger'ダブルクリックしたセル列cell_click_row=Target.Row'選択した行を代入cell_click_column=Target.Column'選択した列を代入'盤上か判定Ifcell_click_row>=3And10>=cell_click_rowAndcell_click_column>=3And10>=cell_click_columnThen'セル内編集モードのキャンセルCancel=True'石が既にあるかの判定IfCells(cell_click_row,cell_click_column).Value=""Then'フォントサイズ指定Cells(2,1).Font.Size=36'●か○か選択Ifstone_countMod2=1Then'ターン数が偶数回か奇数回かのIf文'置き終わったら「白の番です」と表示Cells(2,1)="「白の番です」"'奇数の場合stone=BLACK_STONE'置く石は黒reverse_stone=WHITE_STONE'ひっくり返す石は白Else'置き終わったら「黒の番です」と表示Cells(2,1)="「黒の番です」"'偶数の場合stone=WHITE_STONE'置く石は白reverse_stone=BLACK_STONE'ひっくり返す石は黒EndIf'変数stoneがBLACK_STONEだったら●を置く、WHITE_STONEだったら◯を置くIfstone=BLACK_STONEThenCells(Target.Row,Target.Column).Value=BLACK_STONEElseIfstone=WHITE_STONEThenCells(Target.Row,Target.Column).Value=WHITE_STONEEndIf'盤面情報保存するCallStone_Map'8方向にひっくり返す判定CallStone_Reverse_Right(Target)'右ひっくり返す判定CallStone_Reverse_Left(Target)'左ひっくり返す判定CallStone_Reverse_Up(Target)'上ひっくり返す判定CallStone_Reverse_Down(Target)'下ひっくり返す判定CallStone_Reverse_UpRight(Target)'右上ひっくり返す判定CallStone_Reverse_UpLeft(Target)'左上ひっくり返す判定CallStone_Reverse_DownRight(Target)'右下ひっくり返す判定CallStone_Reverse_DownLeft(Target)'左下ひっくり返す判定'配列データを盤面に反映CallApplyArrayData'手数をカウントアップstone_count=stone_count+1ElseMsgBox"既に石が置かれています。"EndIfElseMsgBox"盤上ではありません。"EndIfEndSubダブルクリックして石を置いたらStone_Mapプロシージャで盤面の状況を取得し、8方向ひっくり返し判定の関数を呼び出して
配列内の盤面を更新した後、実際のセルに配列の盤面状況を反映させてひっくり返しています。
FunctionStone_Map()'盤面情報保存関数DimiAsInteger'For文用rowカウンタDimjAsInteger'For文用columnカウンタi=0'rowカウンタ初期化j=0'columnカウンタ初期化'盤面情報を配列に保存Fori=0To7Forj=0To7stone_arr(i,j)=Cells(i+3,j+3)NextNextEndFunction盤面情報を配列内に格納していく関数です。For分をネストして盤面に見立てた二次元配列に白黒どちらの石があるかを格納してます。
'////////////////////////////////////////////////////////////////////////////////////'/////////////////////////右方向ひっくり返す関数/////////////////////////////////////'////////////////////////////////////////////////////////////////////////////////////FunctionStone_Reverse_Right(ByValTargetAsRange)DimiAsInteger'反対の色の石探索用のカウンタi=0Dima_row,a_colAsInteger'座標変換用変数a_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入DimrAsInteger'ひっくり返す用カウンタIf3<=Target.ColumnAndTarget.Column<=8Then'選択セルの列がエクセル上の座標で3～8の間だったらDoWhile0<a_col+i<7'左右端を除いた範囲で繰り返すCONTINUE:'反対色の石が続いた時の戻る用ラベルi=i+1'反対の色の石探索用のカウンタ変数インクリメントIfstone_arr(a_row,a_col+i)=reverse_stoneThen'一つ右の石が反対色の石か？Ifstone_arr(a_row,a_col+i+1)=stoneThen'さらにもう一つ右の石が同じ色か？r=a_col+i'ひっくり返す用カウンタに一個前の列座標を入れるDoWhiler>a_col'石置いた列までひっくり返しループIfstone=BLACK_STONEThen'置いた石が黒石だったらstone_arr(a_row,r)=BLACK_STONE'一個前の配列データを●にひっくり返すElseIfstone=WHITE_STONEThen'置いた石が白石だったらstone_arr(a_row,r)=WHITE_STONE'一個前の配列データを◯にひっくり返すEndIfr=r-1'ひっくり返す用カウンタ変数をデクリメント(置いた位置まで戻る)LoopElseIfstone_arr(a_row,a_col+i+1)=reverse_stoneThenGoToCONTINUEEndIfEndIfExitDo'最初のループ抜けるLoopEndIfEndFunction右方向のひっくり返す判定です。
最初に石がひっくり返す判定が必要な場所に置かれたかを判断してからひっくり返す必要がある範囲でループして
配列内で石をひっくり返して行きます。
'*************************************************************************************'******************************左方向ひっくり返す関数*********************************'*************************************************************************************FunctionStone_Reverse_Left(ByValTargetAsRange)DimiAsInteger'反対の色の石探索用のカウンタi=0Dima_row,a_colAsInteger'座標変換用変数a_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入DimrAsInteger'ひっくり返す用カウンタIf5<=Target.ColumnAndTarget.Column<=10Then'選択セルの行が5～10の間だったら(左ひっくり返す判定が必要な位置)DoWhile0<a_col+i<7'左右端を除いた位置の間繰り返すCONTINUE:'反対色の石が続いた時の戻る用ラベルi=i+1'反対の色の石探索用のカウンタ変数インクリメントIfstone_arr(a_row,a_col-i)=reverse_stoneThen'配列内の一つ左の石が反対色の石か？Ifstone_arr(a_row,a_col-i-1)=stoneThen'配列内のさらにもう一つ左の石が同じ色か？r=a_col-i'ひっくり返す用カウンタに一個前の列座標を入れるDoWhiler<a_col'石置いた位置までひっくり返しループIfstone=BLACK_STONEThenstone_arr(a_row,r)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(a_row,r)=WHITE_STONE'一個前を◯にひっくり返すEndIfr=r+1'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)LoopElseIfstone_arr(a_row,a_col-i-1)=reverse_stoneThen'さらにもう一つ左の石が反対色だったらiインクリメントまでスキップGoToCONTINUEEndIfEndIfExitDo'最初のループ抜けるLoopEndIfEndFunction'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'++++++++++++++++++++++++上方向ひっくり返す関数++++++++++++++++++++++++++++'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++FunctionStone_Reverse_Up(ByValTargetAsRange)DimiAsInteger'反対の色の石探索用のカウンタi=0Dima_row,a_colAsInteger'座標変換用変数DimrAsInteger'ひっくり返す用カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If5<=Target.RowAndTarget.Row<=10Then'選択セルの列が5～10の間だったら(上ひっくり判定が必要な位置に石を置いたか)DoWhile0<a_row+i<7'上下端を除いた位置の間で繰り返すCONTINUE:'反対色の石が続いた時の戻る用ラベルi=i+1'反対の色の石探索用のカウンタ変数インクリメントIfstone_arr(a_row-i,a_col)=reverse_stoneThen'一つ上の石が反対色の石か？Ifstone_arr(a_row-i-1,a_col)=stoneThen'さらにもう一つ上の石が同じ色か？r=a_row-i'ひっくり返す用カウンタに一個前の列座標を入れるDoWhiler<a_row'ひっくり返しループIfstone=BLACK_STONEThenstone_arr(r,a_col)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(r,a_col)=WHITE_STONE'一個前を◯にひっくり返すEndIfr=r+1'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)LoopElseIfstone_arr(a_row-i-1,a_col)=reverse_stoneThen'もう一つ上の石が反対色だったらiインクリメントまでスキップGoToCONTINUEEndIfEndIfExitDo'最初のループ抜けるLoopEndIfEndFunction'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@@@@@@@@@@@@@@下方向ひっくり返す判定@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FunctionStone_Reverse_Down(ByValTargetAsRange)DimiAsInteger'x軸方向のカウンタi=0Dima_row,a_colAsInteger'座標変換用変数DimrAsInteger'ひっくり返す用カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If3<=Target.RowAndTarget.Row<=8Then'選択セルの列が3～8の間だったら(下ひっくり判定が必要な位置に石を置いたか)DoWhile0<a_row+i<7'ひっくり返し判定を繰り返す範囲CONTINUE:'反対色の石が続いた時の戻る用ラベルi=i+1'反対の色の石探索用のカウンタ変数インクリメントIfstone_arr(a_row+i,a_col)=reverse_stoneThen'一つ下の石が反対色の石か？Ifstone_arr(a_row+i+1,a_col)=stoneThen'さらにもう一つ下の石が同じ色か？(ひっくり返し終端か？)r=a_row+i'ひっくり返す用カウンタに一個前の列座標を入れるDoWhiler>a_row'ひっくり返しループ ※a_row(置いた石の行)より下の位置の間だけ繰り返すIfstone=BLACK_STONEThenstone_arr(r,a_col)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(r,a_col)=WHITE_STONE'一個前を◯にひっくり返すEndIfr=r-1'ひっくり返す用カウンタ変数をデクリメント(上に戻っていく)LoopElseIfstone_arr(a_row+i+1,a_col)=reverse_stoneThen'もう一つ下の石が反対色だったらiインクリメントまでスキップGoToCONTINUEEndIfEndIfExitDo'最初のループ抜けるLoopEndIfEndFunction'--------------------------------------------------------------------------'-----------------------右上方向ひっくり返す関数---------------------------'--------------------------------------------------------------------------FunctionStone_Reverse_UpRight(ByValTargetAsRange)DimxAsInteger'反対の色の石探索x軸方向用のカウンタx=1DimyAsInteger'反対の色の石探索y軸方向用のカウンタy=1Dima_row,a_colAsInteger'座標変換用変数DimrxAsInteger'ひっくり返す用x軸カウンタDimryAsInteger'ひっくり返す用y軸カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If(5<=Target.RowAndTarget.Row<=10)And(3<=Target.ColumnAndTarget.Column<=8)Then'選択セルの行が5～10且つ列が3～8だったら(右上ひっくり判定が必要な位置に石を置いたか)DoWhile(0<a_row+y<7)And(0<a_col+x<7)'上下左右端を除いた位置の間で繰り返すIfstone_arr(a_row-y,a_col+x)=""Then'一つ右上に石がなかったら？ExitDo'ひっくり返しループ抜けるEndIfIfstone_arr(a_row-y,a_col+x)=reverse_stoneThen'一つ右上の石が置いた石と反対色の石か？Ifstone_arr(a_row-y-1,a_col+x+1)=stoneThen'さらにもう一つ右上の石が置いた石と同じ色か？(ひっくり判定終端か？)rx=a_col+x'ひっくり返す用カウンタに一個前の列座標を入れるry=a_row-y'ひっくり返す用カウンタに一個前の列座標を入れるDoWhile(ry<a_row)And(rx>a_col)'ひっくり返しループIfstone=BLACK_STONEThenstone_arr(ry,rx)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(ry,rx)=WHITE_STONE'一個前を◯にひっくり返すEndIfrx=rx-1'ひっくり返す用カウンタ変数をインクリメント(左に戻っていく)ry=ry+1'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)LoopEndIfEndIfx=x+1'反対の色の石探索用のx軸カウンタ変数インクリメントy=y+1'反対の色の石探索用のy軸カウンタ変数インクリメントLoopEndIfEndFunction'--------------------------------------------------------------------------'-----------------------右上方向ひっくり返す関数---------------------------'--------------------------------------------------------------------------'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\左上方向ひっくり返す関数\\\\\\\\\\\\\\\\\\\\\\\\\\\'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\FunctionStone_Reverse_UpLeft(ByValTargetAsRange)DimxAsInteger'反対の色の石探索x軸方向用のカウンタx=1DimyAsInteger'反対の色の石探索y軸方向用のカウンタy=1Dima_row,a_colAsInteger'座標変換用変数DimrxAsInteger'ひっくり返す用x軸カウンタDimryAsInteger'ひっくり返す用y軸カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If(5<=Target.RowAndTarget.Row<=10)And(5<=Target.ColumnAndTarget.Column<=10)Then'選択セルの行が5～10且つ列が5～10だったら(右上ひっくり判定が必要な位置に石を置いたか)DoWhile(0<a_row+y<7)And(0<a_col+x<7)'上下左右端を除いた位置の間で繰り返すIfstone_arr(a_row-y,a_col-x)=""Then'一つ左上に石がなかったら？ExitDo'ひっくり返しループ抜けるEndIfIfstone_arr(a_row-y,a_col-x)=reverse_stoneThen'一つ左上の石が置いた石と反対色の石か？Ifstone_arr(a_row-y-1,a_col-x-1)=stoneThen'さらにもう一つ左上の石が置いた石と同じ色か？(ひっくり判定終端か？)rx=a_col-x'ひっくり返す用カウンタに一個前の列座標を入れるry=a_row-y'ひっくり返す用カウンタに一個前の列座標を入れるDoWhile(ry<a_row)And(rx<a_col)'ひっくり返しループIfstone=BLACK_STONEThenstone_arr(ry,rx)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(ry,rx)=WHITE_STONE'一個前を◯にひっくり返すEndIfrx=rx+1'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)ry=ry+1'ひっくり返す用カウンタ変数をインクリメント(下に戻っていく)LoopEndIfEndIfx=x+1'反対の色の石探索用のx軸カウンタ変数インクリメントy=y+1'反対の色の石探索用のy軸カウンタ変数インクリメントLoopEndIfEndFunction'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\左上方向ひっくり返す関数\\\\\\\\\\\\\\\\\\\\\\\\\\\'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'##############################################################################################'####################################右下方向ひっくり返す関数##################################'##############################################################################################FunctionStone_Reverse_DownRight(ByValTargetAsRange)DimxAsInteger'反対の色の石探索x軸方向用のカウンタx=1DimyAsInteger'反対の色の石探索y軸方向用のカウンタy=1Dima_row,a_colAsInteger'座標変換用変数DimrxAsInteger'ひっくり返す用x軸カウンタDimryAsInteger'ひっくり返す用y軸カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If(3<=Target.RowAndTarget.Row<=8)And(3<=Target.ColumnAndTarget.Column<=8)Then'選択セルの行が3～8且つ列が3～8だったら(右上ひっくり判定が必要な位置に石を置いたか)DoWhile(0<a_row+y<7)And(0<a_col+x<7)'上下左右端を除いた位置の間で繰り返すIfstone_arr(a_row+y,a_col+x)=""Then'一つ右下に石がなかったら？ExitDo'ひっくり返しループ抜けるEndIfIfstone_arr(a_row+y,a_col+x)=reverse_stoneThen'一つ右上の石が置いた石と反対色の石か？Ifstone_arr(a_row+y+1,a_col+x+1)=stoneThen'さらにもう一つ右上の石が置いた石と同じ色か？(ひっくり判定終端か？)rx=a_col+x'ひっくり返す用カウンタに一個前の列座標を入れるry=a_row+y'ひっくり返す用カウンタに一個前の列座標を入れるDoWhile(ry>a_row)And(rx>a_col)'ひっくり返しループIfstone=BLACK_STONEThenstone_arr(ry,rx)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(ry,rx)=WHITE_STONE'一個前を◯にひっくり返すEndIfrx=rx-1'ひっくり返す用カウンタ変数をインクリメント(左に戻っていく)ry=ry-1'ひっくり返す用カウンタ変数をインクリメント(上に戻っていく)LoopEndIfEndIfx=x+1'反対の色の石探索用のx軸カウンタ変数インクリメントy=y+1'反対の色の石探索用のy軸カウンタ変数インクリメントLoopEndIfEndFunction'##############################################################################################'####################################右下方向ひっくり返す関数##################################'##############################################################################################'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@左下方向ひっくり返す関数FunctionStone_Reverse_DownLeft(ByValTargetAsRange)DimxAsInteger'反対の色の石探索x軸方向用のカウンタx=1DimyAsInteger'反対の色の石探索y軸方向用のカウンタy=1Dima_row,a_colAsInteger'座標変換用変数DimrxAsInteger'ひっくり返す用x軸カウンタDimryAsInteger'ひっくり返す用y軸カウンタa_row=Target.Row-3'選択セルの行を配列上の座標に変換して代入a_col=Target.Column-3'選択セルの列を配列上の座標に変換して代入If(3<=Target.RowAndTarget.Row<=8)And(5<=Target.ColumnAndTarget.Column<=10)Then'選択セルの行が3～8且つ列が3～8だったら(右上ひっくり判定が必要な位置に石を置いたか)DoWhile(0<a_row+y<7)And(0<a_col+x<7)'上下左右端を除いた位置の間で繰り返すIfstone_arr(a_row+y,a_col-x)=""Then'一つ左下に石がなかったら？ExitDo'ひっくり返しループ抜けるEndIfIfstone_arr(a_row+y,a_col-x)=reverse_stoneThen'一つ左下の石が置いた石と反対色の石か？Ifstone_arr(a_row+y+1,a_col-x-1)=stoneThen'さらにもう一つ左下の石が置いた石と同じ色か？(ひっくり判定終端か？)rx=a_col-x'ひっくり返す用カウンタに一個前の列座標を入れるry=a_row+y'ひっくり返す用カウンタに一個前の列座標を入れるDoWhile(ry>a_row)And(rx<a_col)'ひっくり返しループIfstone=BLACK_STONEThenstone_arr(ry,rx)=BLACK_STONE'一個前を●にひっくり返すElseIfstone=WHITE_STONEThenstone_arr(ry,rx)=WHITE_STONE'一個前を◯にひっくり返すEndIfrx=rx+1'ひっくり返す用カウンタ変数をインクリメント(右に戻っていく)ry=ry-1'ひっくり返す用カウンタ変数をインクリメント(上に戻っていく)LoopEndIfEndIfx=x+1'反対の色の石探索用のx軸カウンタ変数インクリメントy=y+1'反対の色の石探索用のy軸カウンタ変数インクリメントLoopEndIfEndFunction斜め方向は２つカウンタを使ってループさせてなんとかひっくり返すことが出来ました。
FunctionApplyArrayData()'配列データを盤面に反映させる関数DimiAsInteger'For文用rowカウンタDimjAsInteger'For文用columnカウンタi=0'rowカウンタ初期化j=0'columnカウンタ初期化Fori=0To7Forj=0To7Cells(i+3,j+3)=stone_arr(i,j)NextNextEndFunction最初に盤面情報を取得した関数の逆バージョンで配列の中の盤面情報をExcelのセルへ反映させてます。
まとめ
前回投稿から大分時間が経ってしまいましたがなんとかひっくり返す所まで完成しました。
あとはまだひっくり返せない・ひっくり返す意思がない場所に石を置けてしまうのでひっくり返すことが可能な場所だけに石を置けるようにしたいです。それとパスできるようにするのと石を数えて勝利判定を実装くらいでしょうか。
中々難しそうですが頑張って完成目指します。