オセロを作りながらVBAを学ぼう№9

最終更新日：2017-12-06

オセロを作りながらマクロVBAを学ぼう№9

ExcelマクロVBAでオセロ（リバーシ）を作っていきながらマクロVBAを学ぶ第9回です。

前回までで人が打つのであれば不自由のない機能が実装できたと思います。

さて、ここからはPC対戦の機能を入れていきます。

いきなり強いソフトとかは考えずに、
とにかく自動で打つことができる機能を入れてみます。

必要な機能としては、

・手番が「ＰＣ」なのかの判定
・「PC」が手番の時に打つべき場所を決める
・「PC」が手番の時に石を打つ
・PCが打つときは、少し待ち時間を作る
・PCvsPCの時は、待ち時間を無くす。
・PCvsPCの時は、パスのメッセージを表示しない。

難しいのは、
打つべき場所を決める
ここになりますが、
今回は、打てる場所から適当に選択することにします。
適当に打つので、当然弱いのはあたりまえです。
とにかく、自動で打ち返してくれるようにします。
さらに、PCvsPCで、全自動対戦もできるようにしておきます。

PC対戦のプロシージャーは今後増えそうなので、
標準モジュールを挿入して、
Module2
新規プロシージャーは、こちらに追記していくことにします。

手番が「ＰＣ」なのかの判定

手番がPCならTrueを返すFunctionを作成します。

Function isPC() As Boolean
　　isPC = False
　　With TargetSheet
　　　　If .Range("手番石").Font.Color = .Range("先番石").Font.Color Then
　　　　　　If Sheet1.cmb1.Text Like "ＰＣ*" Then
　　　　　　　　isPC = True
　　　　　　End If
　　　　Else
　　　　　　If Sheet1.cmb2.Text Like "ＰＣ*" Then
　　　　　　　　isPC = True
　　　　　　End If
　　　　End If
　　End With
End Function

Like "ＰＣ*"
このようにしたのは、
今後、PCの強さによって複数作った時のための布石になります。

「PC」が手番の時に打つべき場所を決める

既に、石が置けるかどうかの判定は出来ています。
is置ける全方向
これを使って、石が置ける場所を全て取得します。

Function 次手候補() As Range
　　Dim ix As Long
　　Dim myRng As Range
　　Dim aryRng() As Range
　　With TargetSheet
　　　　ix = 0
　　　　For Each myRng In .Range("盤面")
　　　　　　If is置ける全方向(myRng, True) Then
　　　　　　　　ReDim Preserve aryRng(ix)
　　　　　　　　Set aryRng(ix) = myRng
　　　　　　　　ix = ix + 1
　　　　　　End If
　　　　Next
　　　　Randomize
　　　　ix = Int(Rnd * (UBound(aryRng) + 1))
　　　　Set 次手候補 = aryRng(ix)
　　End With
End Function

配列を使っています、配列については、
配列の使い方について
動的配列
これらのページを参照してください。

石が置ける場所を、
is置ける全方向
これで取得したら、その場所（セル）を配列に入れます。
全ての置ける場所が取得出来たら、
配列のなかから、ランダムに1セルに決めます。
Rnd
これを使う前に、
Randomize
こちらを実行しておかないと、乱数表が更新されないので、結果として毎回同じになってしまいます。
配列の要素数内での乱数作成になります。
指定範囲内の乱数は、一般的には、
Int((最大値 - 最小値 + 1) * Rnd + 最小値))
となります。
今回の場合は、配列の最小値は0なので、数式が簡単になってます。

・「PC」が手番の時に石を打つ
・PCが打つときは、少し待ち時間を作る
・PCvsPCの時は、待ち時間を無くす。
・PCvsPCの時は、パスのメッセージを表示しない。

ここは細かい修正になります。
赤太字が変更箇所です。

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public TargetSheet As Worksheet
Public 置く石 As Range
Public 相手石 As Range
Public isPCvsPC As Boolean

Sub 対戦開始()
　　With TargetSheet
　　　　If WorksheetFunction.CountA(.Range("盤面")) > 4 Then
　　　　　　If MsgBox("対局途中です。" & vbLf & vbLf & _
　　　　　　　　　　　　"新規対局を開始してもよろしいですか？", _
　　　　　　　　　　　　vbYesNo, "確認") = vbNo Then
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　　　If Sheet1.cmb1.Text Like "ＰＣ*" And Sheet1.cmb2.Text Like "ＰＣ*" Then
　　　　　　isPCvsPC = True
　　　　Else
　　　　　　isPCvsPC = False
　　　　End If
　　　　.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), 相手石)
　　　　Call 置ける場所表示
　　　　If isPC Then
　　　　　　Call 次手着手(次手候補)
　　　　End If
　　End With
End Sub

PCvsPCの判定と、
PCが先番の時に、直ぐに打ち始めるようにしています。

Sub 次手着手(ByVal Target As Range)
　　Call 共通変数設定
　　If is置ける全方向(Target, False) Then
　　　　Call 手番交代
　　　　Call 置ける場所表示
　　　　Call 終局確認
　　　　Call パス確認
　　　　If isPC Then
　　　　　　If Not isPCvsPC Then
　　　　　　　　Sleep 400
　　　　　　End If
　　　　　　Call 次手着手(次手候補)
　　　　End If
　　End If
End Sub

人間にしろPCにしろ、
石を置くときはは、このプロシージャーを経由させていますので、
次の手番がPCの時には、自動で撃たせるようにしています。

Sub パス確認()
　　Dim myRng As Range
　　Dim isPass As Boolean
　　With TargetSheet
　　　　isPass = True
　　　　For Each myRng In .Range("盤面")
　　　　　　If is置ける全方向(myRng, True) Then
　　　　　　　　isPass = False
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If isPass = True Then
　　　　　　If Not isPCvsPC Then
　　　　　　　　If .Range("手番石").Font.Color = .Range("先番石").Font.Color Then
　　　　　　　　　　MsgBox "●先手番「" & Sheet1.cmb1.Text & "」" & vbLf & vbLf & "パス"
　　　　　　　　Else
　　　　　　　　　　MsgBox "○後手番「" & Sheet1.cmb2.Text & "」" & vbLf & vbLf & "パス"
　　　　　　　　End If
　　　　　　End If
　　　　　　Call 手番交代
　　　　　　Call 置ける場所表示
　　　　　　Call 終局確認
　　　　End If
　　End With
End Sub

ここは、PCvsPCの時にメッセージを表示しないようにしているだけです。

すでに必要なプロシージャーはほとんどできているので、
大きな変更も無く、割と簡単にPC対戦を実装できました。

ただし、非常に弱い。
ルールだけ聞いた人が、いきなり始めたととしても大抵は勝てるレベルになります。
とにかく打てる場所に適当に置いているのですから仕方ありません。

さすがに、これでは仕方ないので、
次回は、置く場所を少し厳選してもう少し強くします。

№10へ続きます。

全体の目次