オセロを作りながらマクロ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 ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.繰り返し処理(For Next)|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.ブック・シートの選択(Select,Activate)|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- オセロを作りながらマクロVBAを学ぼう№15
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。