オセロ

最近はオセロにはまっていて、　

相手の打つ箇所のシミュレーションをしてみたくて、

こんなの作りました。

Step1.　START

　　順番の色の駒を選んで、

　　駒の置く位置サーチ開始...

　　Sub osero()

　　　 Dim koma As String
 　　　koma = Selection.Value
 　　　If koma = "" Then Exit Sub
 　　　Search_koma (koma)
 　　End Sub

Step2．

　　選んだ色の駒置く位置判断 

     Sub Search_koma(ByVal koma)

          Dim c As Range
          Dim firstAddress As String
       With Worksheets(1).Range("E4:L11")
          Set c = .Find(koma, LookIn:=xlValues, lookat:=xlWhole)
          If Not c Is Nothing Then
             firstAddress = c.Address
            Do
              Set c = .FindNext(c)
               Dim x As Integer
               Dim y As Integer
                For x = -1 To 1 Step 1
                  For y = -1 To 1 Step 1
                    Call チェック(c.Address, koma, x, y)
                  Next y
                Next x
               If c Is Nothing Then Exit Do
           Loop Until c.Address = firstAddress
        End If
    End With
End Sub

Step3.　チェックの中身を作成

　　　Sub チェック(ByVal Address, ByVal koma, ByVal xDir, ByVal yDir)
    　　   '隣の駒の位置が　横<5 or 横>12
   　　　'                      縦<４　or 縦>11
   　　　'盤面の外なので、判断中止
   　　　　  Dim TheLastResult As String
   　　　　　Dim this As Range
  　　　　　 Set this = Range(Address)
   　　　　　Call check_next(this, koma, xDir, yDir)
　　　End Sub

Step4. 次を判断する関数を作成

　
   '隣の駒をチェック
     '反対色なら、さらに隣の駒をチェック
     '同じ色なら、ここでは置けないと判断
     'なにもなければ、さらに、一つ前の判断結果も反対色の場合、
       '置けると判断

　　Sub check_next(this As Range, ByVal koma, ByVal xDir, ByVal yDir)
   　　   Do While (this.Column > 5 And this.Column < 12) _
              And (this.Row > 4 And this.Row < 11)
      　　Set this = this.Offset(xDir, yDir)
      
      　　If this.Value = 反対色(koma) Then
         　　Call check_next(this, koma, xDir, yDir)
      　　ElseIf this.Value = koma Then
         　　Exit Do
      　　ElseIf this.Value = "" Then
         　　　If check_privous(this, xDir * (-1), yDir * (-1)) = 反対色(koma) Then
             　　　 this.Value = koma & "'"  
        　　　 End If
      　　End If
     Loop
End Sub

Step5.　前の駒の色判断関数作成

　　　　＆　反対色の関数を作成

Function check_privous(this As Range, ByVal xDir, ByVal yDir)
     check_privous = this.Offset(xDir, yDir).Value
End Function

Function 反対色(ByVal koma)
    Dim opp
    If koma = "b" Then
      opp = "w"
    ElseIf koma = "w" Then
      opp = "b"
   End If
   反対色 = opp
End Function

どんなイメージか！？

最初に真ん中に駒を置いて、次に打つ駒のセルを選択して、

ボタン1をおしたら、W'はホワイトが置ける場所を示している。

これを使いながら、定石を覚えていこうと思っています。