AI対戦型OthelloGame for Excel コード・プログラム
【コード・プログラム】
Option Explicit
Dim board(1 To 8, 1 To 8) As String
Dim turn As String
Dim gameOver As Boolean
Const topRow As Long = 3
Const leftCol As Long = 4
Sub StartOthello()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
ws.Cells.Clear
ws.Name = "Othello"
' セルサイズ調整（正方形）
Dim i As Long
For i = 1 To 20
ws.Columns(i).ColumnWidth = 4.2
ws.Rows(i).RowHeight = 22.5
Next i
' 初期化
Dim r As Long, c As Long
For r = 1 To 8
For c = 1 To 8
board(r, c) = ""
With ws.Cells(topRow + r - 1, leftCol + c - 1)
.Interior.Color = RGB(0, 128, 0)
.Font.Size = 14
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = ""
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
Next c
Next r
' 初期配置
board(4, 4) = "●": board(5, 5) = "●"
board(4, 5) = "〇": board(5, 4) = "〇"
Call DrawBoard
turn = "●"
gameOver = False
ws.Cells(topRow + 9, leftCol).Value = "●: 2"
ws.Cells(topRow + 9, leftCol + 1).Value = "〇: 2"
ws.Cells(topRow + 9, leftCol + 3).Value = "←あなたの番"
' Enterキーで石を置く
Application.OnKey "~", "PlaceStone"
End Sub
Sub DrawBoard()
Dim r As Long, c As Long
For r = 1 To 8
For c = 1 To 8
ThisWorkbook.Sheets(1).Cells(topRow + r - 1, leftCol + c - 1).Value = board(r, c)
Next c
Next r
Call CountPieces
End Sub
Sub CountPieces()
Dim b As Long, w As Long, r As Long, c As Long
For r = 1 To 8
For c = 1 To 8
If board(r, c) = "●" Then b = b + 1
If board(r, c) = "〇" Then w = w + 1
Next c
Next r
With ThisWorkbook.Sheets(1)
.Cells(topRow + 9, leftCol).Value = "●: " & b
.Cells(topRow + 9, leftCol + 1).Value = "〇: " & w
End With
End Sub
Sub PlaceStone()
Dim r As Long, c As Long
r = ActiveCell.Row - topRow + 1
c = ActiveCell.Column - leftCol + 1
If r < 1 Or r > 8 Or c < 1 Or c > 8 Then Exit Sub
If board(r, c) <> "" Then Exit Sub
If turn <> "●" Then Exit Sub
If Not FlipPieces(r, c, turn) Then Exit Sub
board(r, c) = turn
Call DrawBoard
turn = "〇"
ThisWorkbook.Sheets(1).Cells(topRow + 9, leftCol + 3).Value = "←AIの番"
DoEvents
Application.Wait Now + TimeValue("0:00:01")
Call AIMove
End Sub
Sub AIMove()
Dim r As Long, c As Long
For r = 1 To 8
For c = 1 To 8
If board(r, c) = "" Then
If FlipPieces(r, c, turn) Then
board(r, c) = turn
Call DrawBoard
turn = "●"
ThisWorkbook.Sheets(1).Cells(topRow + 9, leftCol + 3).Value = "←あなたの番"
Exit Sub
End If
End If
Next c
Next r
ThisWorkbook.Sheets(1).Cells(topRow + 9, leftCol + 3).Value = "←パス"
End Sub
Function FlipPieces(r As Long, c As Long, player As String) As Boolean
Dim dr As Long, dc As Long, i As Long
Dim flipped As Boolean
Dim opp As String: opp = IIf(player = "●", "〇", "●")
For dr = -1 To 1
For dc = -1 To 1
If dr <> 0 Or dc <> 0 Then
Dim path As Collection: Set path = New Collection
Dim rr As Long: rr = r + dr
Dim cc As Long: cc = c + dc
Do While rr >= 1 And rr <= 8 And cc >= 1 And cc <= 8
If board(rr, cc) = opp Then
path.Add Array(rr, cc)
ElseIf board(rr, cc) = player Then
If path.Count > 0 Then
For i = 1 To path.Count
Dim pos: pos = path(i)
board(pos(0), pos(1)) = player
Next i
flipped = True
End If
Exit Do
Else
Exit Do
End If
rr = rr + dr
cc = cc + dc
Loop
End If
Next dc
Next dr
FlipPieces = flipped
End Function
【実際に動かしてるところの動画】
https://youtube.com/shorts/4Gu6Anl4MEs?si=X57ywHNZvkz96R_k
