オセロを作りながら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

配列を使っています、配列については、
配列の使い方について
動的配列

静的配列では、配列の要素数は宣言時点で決められていました、しかし、プログラミングをする上で、実行時点で要素数を決めたい場合や、実行途中で増やしたい場合が多くあります。実行時点で要素数を増減できるのが、動的配列になります。Excelマクロの基礎と応用、エクセルVBAの入門・初級・初心者向け解説

これらのページを参照してください。

石が置ける場所を、
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