EXCEL VBA 初心者でもできる！Excelで遊べる三目並べ!Tic-Tac-Toe（コード解説付き・ダウンロード可能）

EXCEL VBA 初心者でもできる！Excelで遊べる三目並べ!ゲームを作る（コード解説付き・ダウンロード可能）

Excel VBAで三目並べゲームを作ってみた！①：二人で遊ぶ(　人間　対　人間）

Option Explicit

' 公開変数の宣言
Public currentPlayer As String
Public moveCount As Integer

' セルが選択されたときに実行されるイベント
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B2:D4")) Is Nothing Then
        If IsEmpty(Target.Value) And moveCount < 9 Then
            Target.Value = currentPlayer
            moveCount = moveCount + 1

            If CheckWinner(currentPlayer) Then
                MsgBox currentPlayer & " wins!"
                StartGame
            ElseIf moveCount = 9 Then
                MsgBox "It's a draw!"
                StartGame
            Else
                TogglePlayer
            End If
        End If
    End If
End Sub

' ゲームの開始と初期化
Sub StartGame()
    Dim cell As Range
    For Each cell In Me.Range("B2:D4")
        cell.Value = ""
        cell.Interior.Color = xlNone
    Next cell
    currentPlayer = "X"
    moveCount = 0
End Sub

' プレイヤーの交代
Sub TogglePlayer()
    If currentPlayer = "X" Then
        currentPlayer = "O"
    Else
        currentPlayer = "X"
    End If
End Sub

' 勝利条件のチェック
Function CheckWinner(player As String) As Boolean
    CheckWinner = False
    If CheckThree("B2", "B3", "B4", player) Or CheckThree("C2", "C3", "C4", player) Or _
       CheckThree("D2", "D3", "D4", player) Or CheckThree("B2", "C2", "D2", player) Or _
       CheckThree("B3", "C3", "D3", player) Or CheckThree("B4", "C4", "D4", player) Or _
       CheckThree("B2", "C3", "D4", player) Or CheckThree("B4", "C3", "D2", player) Then
        CheckWinner = True
    End If
End Function

' 3つのセルが同じプレイヤーの記号かチェック
Function CheckThree(cell1 As String, cell2 As String, cell3 As String, player As String) As Boolean
    CheckThree = (Range(cell1).Value = player And Range(cell2).Value = player And Range(cell3).Value = player)
End Function

Excel VBAで三目並べゲームを作ってみた！②：一人で遊ぶ(人間　対　CPU）

'
'
Option Explicit

' 公開変数の宣言
Public currentPlayer As String  ' 現在のプレイヤーを保持する変数（'O' または 'X'）
Public moveCount As Integer     ' ゲーム中の手数をカウントする変数

' セルが選択されたときに実行されるイベントハンドラ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 選択されたセルがゲームのグリッド内かどうかチェック
    If Not Intersect(Target, Me.Range("B2:D4")) Is Nothing Then
        ' セルが空かつ現在のプレイヤーが 'O' の場合
        If IsEmpty(Target.Value) And currentPlayer = "O" Then
            ' 選択されたセルに現在のプレイヤーの記号を設定
            Target.Value = currentPlayer
            ' 手数を1増やす
            moveCount = moveCount + 1

            ' 勝利条件をチェック
            If CheckWinner(currentPlayer) Then
                ' 勝利した場合、勝利メッセージを表示し、ゲームを再開始
                MsgBox currentPlayer & " wins!"
                StartGame
            ' 手数が9以上の場合（引き分け）
            ElseIf moveCount >= 9 Then
                ' 引き分けのメッセージを表示し、ゲームを再開始
                MsgBox "It's a draw!"
                StartGame
            ' それ以外の場合
            Else
                ' コンピューターの手を呼び出し
                ComputerMove
            End If
        End If
    End If
End Sub

' コンピューターの手順
Sub ComputerMove()
    Dim i As Long
    Dim emptyCells As Collection
    Set emptyCells = New Collection  ' 空のセルを格納するためのコレクション
    
    ' タイムディレイのためのループ（パフォーマンス上の問題あり）
    For i = 1 To 100000000
    Next i
    
    Dim cell As Range
    ' ゲームのグリッドをループして空のセルをコレクションに追加
    For Each cell In Me.Range("B2:D4")
        If IsEmpty(cell.Value) Then
            emptyCells.Add cell
        End If
    Next cell

    ' 空のセルがある場合
    If emptyCells.Count > 0 Then
        Dim randomIndex As Integer
        Randomize  ' ランダムな数を生成するための初期化
        ' 空のセルの中からランダムに一つ選択
        randomIndex = Int((emptyCells.Count * Rnd) + 1)
        ' 選択されたセルに 'X' を設定
        emptyCells.Item(randomIndex).Value = "X"
        ' 手数を1増やす
        moveCount = moveCount + 1

        ' 勝利条件をチェック
        If CheckWinner("X") Then
            ' 勝利した場合、勝利メッセージを表示し、ゲームを再開始
            MsgBox "X wins!"
            StartGame
        ' 手数が9以上の場合（引き分け）
        ElseIf moveCount >= 9 Then
            ' 引き分けのメッセージを表示し、ゲームを再開始
            MsgBox "It's a draw!"
            StartGame
        End If
    End If

    ' 次のプレイヤーを 'O' に設定
    currentPlayer = "O"
End Sub

' ゲームの開始と初期化
Sub StartGame()
    Dim cell As Range
    ' ゲームのグリッド内のセルをループしてリセット
    For Each cell In Me.Range("B2:D4")
        cell.Value = ""  ' セルの値をクリア
        'cell.Interior.Color = xlNone  ' セルの背景色をクリア（現在はコメントアウト）
    Next cell
    ' 現在のプレイヤーを 'O' に設定
    currentPlayer = "O"
    ' 手数を0にリセット
    moveCount = 0
End Sub

' 勝利条件のチェック
Function CheckWinner(player As String) As Boolean
    ' 勝利しているかどうかの初期値はFalse
    CheckWinner = False
    ' 各行、各列、または対角線が同じプレイヤーの記号で揃っているかチェック
    If CheckThree("B2", "B3", "B4", player) Or CheckThree("C2", "C3", "C4", player) Or _
       CheckThree("D2", "D3", "D4", player) Or CheckThree("B2", "C2", "D2", player) Or _
       CheckThree("B3", "C3", "D3", player) Or CheckThree("B4", "C4", "D4", player) Or _
       CheckThree("B2", "C3", "D4", player) Or CheckThree("B4", "C3", "D2", player) Then
        CheckWinner = True  ' いずれかの条件を満たしていればTrueに設定
    End If
End Function

' 3つのセルが同じプレイヤーの記号かチェック
Function CheckThree(cell1 As String, cell2 As String, cell3 As String, player As String) As Boolean
    ' 3つのセルがすべて指定されたプレイヤーの記号であればTrue、そうでなければFalseを返す
    CheckThree = (Range(cell1).Value = player And Range(cell2).Value = player And Range(cell3).Value = player)
End Function
'
'

Excel VBAで三目並べゲームを作ってみた！③：１人で遊ぶ(人間　対　AI?CPU）

'
'
Option Explicit

' 公開変数の宣言
Public currentPlayer As String  ' 現在のプレイヤー（'O' または 'X'）を格納する変数
Public moveCount As Integer     ' ゲーム中の手数をカウントする変数

' セルが選択されたときに実行されるイベントハンドラ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 選択されたセルがゲームのグリッド（B2:D4）内にあるかチェック
    If Not Intersect(Target, Me.Range("B2:D4")) Is Nothing Then
        ' セルが空で、現在のプレイヤーが 'O' である場合
        If IsEmpty(Target.Value) And currentPlayer = "O" Then
            ' 選択されたセルに現在のプレイヤーの記号を入力
            Target.Value = currentPlayer
            ' 手数を1増やす
            moveCount = moveCount + 1

            ' 勝利条件をチェックする関数を呼び出し
            If CheckWinner(currentPlayer) Then
                ' 勝利した場合、メッセージボックスで通知し、ゲームを再開始
                MsgBox currentPlayer & " wins!"
                StartGame
            ' 手数が9以上で引き分けの場合
            ElseIf moveCount >= 9 Then
                ' 引き分けのメッセージを表示し、ゲームを再開始
                MsgBox "It's a draw!"
                StartGame
            ' それ以外の場合
            Else
                ' コンピューターの手順を実行
                ComputerMove
            End If
        End If
    End If
End Sub

' コンピューターの手順
Sub ComputerMove()
    Dim i As Long
    Dim emptyCells As Collection
    Set emptyCells = New Collection  ' 空のセルを格納するためのコレクションを初期化
    
    ' 人工的な遅延を作成するためのループ（CPUが考えている感じをだすため）
    For i = 1 To 100000000
    Next i
    
    Dim cell As Range
    ' ゲームのグリッド内の空のセルを探索し、コレクションに追加
    For Each cell In Me.Range("B2:D4")
        If IsEmpty(cell.Value) Then
            emptyCells.Add cell
        End If
    Next cell

    ' 空のセルがある場合
    If emptyCells.Count > 0 Then
        Dim randomIndex As Integer
        Randomize  ' ランダム数生成器を初期化
        ' 空のセルの中からランダムに一つ選択
        randomIndex = Int((emptyCells.Count * Rnd) + 1)
        ' 選択されたセルに 'X' を設定
        emptyCells.Item(randomIndex).Value = "X"
        ' 手数を1増やす
        moveCount = moveCount + 1

        ' 勝利条件をチェック
        If CheckWinner("X") Then
            ' 勝利した場合、メッセージボックスで通知し、ゲームを再開始
            MsgBox "X wins!"
            StartGame
        ' 手数が9以上で引き分けの場合
        ElseIf moveCount >= 9 Then
            ' 引き分けのメッセージを表示し、ゲームを再開始
            MsgBox "It's a draw!"
            StartGame
        End If
    End If

    ' 次のプレイヤーを 'O' に設定
    currentPlayer = "O"
End Sub

' ゲームの開始と初期化
Sub StartGame()
    Dim cell As Range
    ' ゲームのグリッド内のセルをリセット
    For Each cell In Me.Range("B2:D4")
        cell.Value = ""  ' セルの値をクリア
        'cell.Interior.Color = xlNone  ' セルの背景色をクリア
    Next cell
    ' 現在のプレイヤーを 'O' に設定
    currentPlayer = "O"
    ' 手数を0にリセット
    moveCount = 0
End Sub

' 勝利条件のチェック
Function CheckWinner(player As String) As Boolean
    ' 勝利しているかどうかの初期状態はFalse
    CheckWinner = False
    ' 各行、各列、または対角線が同じプレイヤーの記号で揃っているかをチェック
    If CheckThree("B2", "B3", "B4", player) Or CheckThree("C2", "C3", "C4", player) Or _
       CheckThree("D2", "D3", "D4", player) Or CheckThree("B2", "C2", "D2", player) Or _
       CheckThree("B3", "C3", "D3", player) Or CheckThree("B4", "C4", "D4", player) Or _
       CheckThree("B2", "C3", "D4", player) Or CheckThree("B4", "C3", "D2", player) Then
        CheckWinner = True  ' いずれかの条件を満たした場合はTrueに設定
    End If
End Function

' 3つのセルが同じプレイヤーの記号かチェック
Function CheckThree(cell1 As String, cell2 As String, cell3 As String, player As String) As Boolean
    ' 指定された3つのセルが同じプレイヤーの記号であればTrue、そうでなければFalseを返す
    CheckThree = (Range(cell1).Value = player And Range(cell2).Value = player And Range(cell3).Value = player)
End Function
'
'