オセロを作りながらマクロVBAを学ぼう№15
ExcelマクロVBAでオセロ(リバーシ)を作っていきながらマクロVBAを学ぶ第15回です。
棋譜が扱えるようになったので、今回は、対局を再現できるようにします。
1手1手進められるように、1手1手戻せるようにします。

棋譜再現 : btn11
戻る : btn12
進む : btn13
としました。
Private Sub btn11_Click()
Unprotect
StopMsg = False
Set TargetSheet = Sheet1
Call 棋譜再現
Protect
End Sub
Private Sub btn12_Click()
Unprotect
StopMsg = False
Set TargetSheet = Sheet1
Call 棋譜戻る
Protect
End Sub
Private Sub btn13_Click()
Unprotect
StopMsg = False
Set TargetSheet = Sheet1
Call 棋譜進む
Protect
End Sub
イベントプロシージャー内での記述は少なくして、
処理の中核は、標準モジュールに記載します。
イベントプロシージャー内では、エラー時のデバッグ等で使い勝手が良くないので、
なるべく、標準モジュールに書いた方が効率がよいです。
Sub 棋譜再現()
With TargetSheet
If Not StopMsg Then
If WorksheetFunction.CountA(.Range("盤面")) > 4 And .Range("手番石") <> "" Then
If MsgBox("対局途中です。" & vbLf & vbLf & _
"棋譜を再現してもよろしいですか?", _
vbYesNo, "確認") = vbNo Then
Exit Sub
End If
End If
End If
isPCvsPC = False
.Range("先番石").Copy Destination:=.Range("手番石")
.Range("手番石").Offset(, 1) = "の番です。"
.Range("盤面").ClearContents
Call 共通変数設定
Call 石を置く(.Range("盤面").Cells(4, 5), 置く石)
Call 石を置く(.Range("盤面").Cells(5, 4), 置く石)
Call 石を置く(.Range("盤面").Cells(4, 4), 相手石)
Call 石を置く(.Range("盤面").Cells(5, 5), 相手石)
Worksheets("棋譜").Range("D1") = 1
End With
End Sub
Sub 棋譜進む()
Dim i As Long
Dim j As Long
Dim myRng As Range
isPCvsPC = False
With Worksheets("棋譜")
If .Range("D1") = "" Then
Exit Sub
End If
i = .Range("D1") + 1
If .Cells(i, 1) = "" Then
MsgBox "棋譜はここまでです。"
Exit Sub
End If
If .Cells(i, 3) = "黒" Then
Set 置く石 = TargetSheet.Range("先番石")
Else
Set 置く石 = TargetSheet.Range("後番石")
End If
Set myRng = 棋譜ToRange(.Cells(i, 2))
' Call 石を置く(myRng, 置く石)
' For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
' Set myRng = 棋譜ToRange(.Cells(i, j))
' Call 石を置く(myRng, 置く石)
' Next
Call is置ける全方向(myRng, False)
.Range("D1") = i
End With
Call 手番交代
End Sub
Sub 棋譜戻る()
Dim i As Long
Dim j As Long
Dim myRng As Range
isPCvsPC = False
With Worksheets("棋譜")
If .Range("D1") = "" Then
Exit Sub
End If
i = .Range("D1")
If i = 1 Then
Exit Sub
End If
If .Cells(i, 3) = "黒" Then
Set 置く石 = TargetSheet.Range("後番石")
Else
Set 置く石 = TargetSheet.Range("先番石")
End If
Set myRng = 棋譜ToRange(.Cells(i, 2))
myRng = ""
For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
Set myRng = 棋譜ToRange(.Cells(i, j))
Call 石を置く(myRng, 置く石)
Next
.Range("D1") = i - 1
End With
Call 手番交代
End Sub
Function 棋譜ToRange(ByVal str As String) As Range
Dim s1 As String
Dim s2 As String
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = TargetSheet.Range("盤面").Offset(-1, -1).Resize(9, 9)
s1 = Left(str, 1)
s2 = Right(str, 1)
For j = 2 To 9
If rng.Cells(1, j) = s1 Then
Exit For
End If
Next
For i = 2 To 9
If rng.Cells(i, 1) = s2 Then
Exit For
End If
Next
Set 棋譜ToRange = TargetSheet.Range("盤面").Cells(i - 1, j - 1)
End Function
棋譜再現
ここは、「対戦開始」とほぼ同様で、初期配置までを行っています。
「進む」ボタンで1手進めます。
棋譜ToRangeで、棋譜の記号をセル(Range)に変換して、
そこに石を置いています。
棋譜シートの、"D1"セルに再現している手数位置を入れて、これでコントロールしています。
' Call 石を置く(myRng, 置く石)
' For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
' Set myRng = 棋譜ToRange(.Cells(i, j))
' Call 石を置く(myRng, 置く石)
' Next
Call is置ける全方向(myRng, False)
Call is置ける全方向(myRng, False)
これは、通常の対戦時に石を置く時に使っているものをそのまま使っています。
これを使う事で、石を置けば相手の石をひっくり返してくれます。
コメントアウトしている部分は、
Call is置ける全方向(myRng, False)
これの代わりに、棋譜にあるとおりに石を置いて、相手の石をひっくり返すのも棋譜通りに行う場合です。
今回は、通常対戦とおりに、石を置いくことで相手の石もひっくり返しています。
オセロの棋譜がどこかにあったしたら、それを使う事を考慮すれば、
今回のように、棋譜に従って石を置いて、相手の石をひっくり返す法が良いだろうと考えました。
「待った」とほぼ動労の内容となります。
棋譜の現在行の内容で石を元に戻し、
棋譜の現在行("D1")を1行戻します。
f5等の記号から、セル(Rangeオブジェクト)に変換しています。
f5
これを
fと5に分割し、
盤面の上と左にある記号から検索して、セル位置(行と列)を取得しています。
取得した行と列を、Cellsに入れる事でRangeオブジェクトにしています。
強さはそこそこ、使い勝手もそこそこ
と言うところではないでしょうか。
最後のまとめを書いておきたいと思います。
全体の目次
ここまでのサンプルファイルのダウンロード
新着記事NEW ・・・新着記事一覧を見る
AI時代におけるRPAとVBAの位置づけ - 補完技術としての役割と未来 -|生成AI活用研究(2025-05-12)
スマートExcel|AI×Excel:AIと進化するExcelの新常識|生成AI活用研究(2025-05-11)
VBA開発の現場で生成AIはどう使う? そのメリットと潜むリスク|生成AI活用研究(2025-05-11)
CursorでVBAを直接?編集・実行できる環境構築について|生成AI活用研究(2025-05-10)
Geminiと100本ノック 17本目:重複削除(ユニーク化)|生成AI活用研究(5月10日)
Geminiと100本ノック 16本目:無駄な改行を削除|生成AI活用研究(5月6日)
AIがあればVBAはできる:セルに絵文字を入れる|生成AI活用研究(2025-05-07)
Geminiと100本ノック 15本目:シートの並べ替え|生成AI活用研究(5月6日)
Geminiと100本ノック 14本目:社外秘シート削除|生成AI活用研究(5月4日)
Geminiと100本ノック 13本目:文字列の部分フォント|生成AI活用研究(5月4日)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.繰り返し処理(For Next)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
5.ひらがな⇔カタカナの変換|エクセル基本操作
6.RangeとCellsの使い方|VBA入門
7.メッセージボックス(MsgBox関数)|VBA入門
8.セルのクリア(Clear,ClearContents)|VBA入門
9.FILTER関数(範囲をフィルター処理)|エクセル入門
10.条件分岐(Select Case)|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- オセロを作りながらマクロVBAを学ぼう№15
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。