0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

『Excelでリバーシを作ろう! マクロ、VBAを1から学ぶ』コピペ用コード 三目並べ

Last updated at Posted at 2022-04-09

『Excelでリバーシを作ろう!! マクロ、VBAを1から学ぶ』内で使用しているコードです。

Excelのマクロ(VBA)で「三目並べ」「マインスイーパー」「リバーシ」を作る解説本です!
プログラミングが全くわからない人でも大丈夫! 丁寧な解説と図でしっかり理解しながら楽しくプログラミングを学ぶ事ができます!
値段:300円(Kindle Unlimited対象)

サンプルとして「準備」~「三目並べ」を無料公開しています。

【kindle】

【booth(pdf】

「マインスイーパー」
https://qiita.com/sano192/items/8eee84c6cd86db7d9a43
「リバーシ」
https://qiita.com/sano192/items/a9680a3a09d37aad1a17

「三目並べ 2」

「三目並べ 2」
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
 
End Sub

「三目並べ 3」

「三目並べ 3」
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
   
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Gyou = Target.Row
    Retu = Target.Column
   
    If 2 <= Gyou And Gyou <= 4 And 2 <= Retu And Retu <= 4 Then
       
        Cells(Gyou, Retu) = "●"
   
    End If
   
End Sub

「三目並べ 4」

「三目並べ 4」
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
   
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim Gyou, Retu
 
    Gyou = Target.Row
    Retu = Target.Column
   
    If 2 <= Gyou And Gyou <= 4 And 2 <= Retu And Retu <= 4 Then
   
        If Cells(Gyou, Retu) <> "" Then
       
            Exit Sub
       
        End If
   
        If Cells(2, 6) = "黒番" Then
            Cells(Gyou, Retu) = "●"
            Cells(2, 6) = "白番"
       
        ElseIf Cells(2, 6) = "白番" Then
            Cells(Gyou, Retu) = "○"
            Cells(2, 6) = "黒番"
       
        End If
   
    End If
   
End Sub

「三目並べ 5」

「三目並べ 5」
'ゲーム開始の処理
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
   
End Sub
 
'セルをクリックしたときの処理
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'    変数の宣言
    Dim Gyou, Retu
 
'    クリックしたセルの行番号 , 列番号
    Gyou = Target.Row
    Retu = Target.Column
   
'    クリックしたセルが盤面の範囲内なら
    If 2 <= Gyou And Gyou <= 4 And 2 <= Retu And Retu <= 4 Then
   
'        セルが空白なら
        If Cells(Gyou, Retu) <> "" Then
'            処理を途中終了
            Exit Sub
       
        End If
       
'        黒番なら
        If Cells(2, 6) = "黒番" Then
            Cells(Gyou, Retu) = "●"
            Cells(2, 6) = "白番"
       
'        白番なら
        ElseIf Cells(2, 6) = "白番" Then
            Cells(Gyou, Retu) = "○"
            Cells(2, 6) = "黒番"
       
        End If
   
    End If
   
End Sub

「三目並べ 6」

「三目並べ 6」
'ゲーム開始の処理
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
   
End Sub
 
'セルをクリックしたときの処理
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'    変数の宣言
    Dim Gyou, Retu, Result
 
'    クリックしたセルの行番号 , 列番号
    Gyou = Target.Row
    Retu = Target.Column
   
'    クリックしたセルが盤面の範囲内なら
    If 2 <= Gyou And Gyou <= 4 And 2 <= Retu And Retu <= 4 Then
   
'        セルが空白なら
        If Cells(Gyou, Retu) <> "" Then
'            処理を途中終了
            Exit Sub
       
        End If
       
'        黒番なら
        If Cells(2, 6) = "黒番" Then
            Cells(Gyou, Retu) = "●"
            Cells(2, 6) = "白番"
       
'        白番なら
        ElseIf Cells(2, 6) = "白番" Then
            Cells(Gyou, Retu) = "○"
            Cells(2, 6) = "黒番"
       
        End If
   
    End If
   
    Result = Judge
   
    If Result = 1 Then
        Cells(2, 6) = "黒の勝ち"
   
    ElseIf Result = 2 Then
        Cells(2, 6) = "白の勝ち"
   
    ElseIf Result = 3 Then
        Cells(2, 6) = "引き分け"
   
    End If
   
End Sub
 
'勝敗を判定する関数
Function Judge()
 
'    黒が3つ並んでいるか
    If Cells(2, 2) = "●" And Cells(2, 3) = "●" And Cells(2, 4) = "●" Then
        Judge = 1
    ElseIf Cells(3, 2) = "●" And Cells(3, 3) = "●" And Cells(3, 4) = "●" Then
        Judge = 1
    ElseIf Cells(4, 2) = "●" And Cells(4, 3) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 2) = "●" And Cells(3, 2) = "●" And Cells(4, 2) = "●" Then
        Judge = 1
    ElseIf Cells(2, 3) = "●" And Cells(3, 3) = "●" And Cells(4, 3) = "●" Then
        Judge = 1
    ElseIf Cells(2, 4) = "●" And Cells(3, 4) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 2) = "●" And Cells(3, 3) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 4) = "●" And Cells(3, 3) = "●" And Cells(4, 2) = "●" Then
        Judge = 1
   
'    白が3つ並んでいるか
    ElseIf Cells(2, 2) = "○" And Cells(2, 3) = "○" And Cells(2, 4) = "○" Then
        Judge = 2
    ElseIf Cells(3, 2) = "○" And Cells(3, 3) = "○" And Cells(3, 4) = "○" Then
        Judge = 2
    ElseIf Cells(4, 2) = "○" And Cells(4, 3) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 2) = "○" And Cells(3, 2) = "○" And Cells(4, 2) = "○" Then
        Judge = 2
    ElseIf Cells(2, 3) = "○" And Cells(3, 3) = "○" And Cells(4, 3) = "○" Then
        Judge = 2
    ElseIf Cells(2, 4) = "○" And Cells(3, 4) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 2) = "○" And Cells(3, 3) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 4) = "○" And Cells(3, 3) = "○" And Cells(4, 2) = "○" Then
        Judge = 2
       
    End If
   
'    黒または白の勝ちの場合
    If Judge = 1 Or Judge = 2 Then
   
'        途中終了
        Exit Function
       
    End If
   
    Dim Gyou, Retu
 
'    空白マスがあるか確認する
    For Gyou = 2 To 4
        For Retu = 2 To 4
       
            If Cells(Gyou, Retu) = "" Then
                Judge = 4
            End If
       
        Next Retu
    Next Gyou
 
'    全てのマスが埋まっている場合
    If Judge <> 4 Then
        Judge = 3
    End If
 
End Function

「三目並べ コード全文」

「三目並べ コード全文」
'ゲーム開始の処理
Sub GameStart()
 
    Range("B2", "D4").ClearContents
    Cells(2, 6) = "黒番"
    Cells(1, 1).Select

End Sub
 
'セルをクリックしたときの処理
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'    変数の宣言
    Dim Gyou, Retu, Result
 
'    クリックしたセルの行番号 , 列番号
    Gyou = Target.Row
    Retu = Target.Column
   
'    クリックしたセルが盤面の範囲内なら
    If 2 <= Gyou And Gyou <= 4 And 2 <= Retu And Retu <= 4 Then
   
'        セルが空白なら
        If Cells(Gyou, Retu) <> "" Then
'            処理を途中終了
            Exit Sub
       
        End If
       
'        黒番なら
        If Cells(2, 6) = "黒番" Then
            Cells(Gyou, Retu) = "●"
            Cells(2, 6) = "白番"
       
'        白番なら
        ElseIf Cells(2, 6) = "白番" Then
            Cells(Gyou, Retu) = "○"
            Cells(2, 6) = "黒番"
       
        End If
   
    End If
   
    Result = Judge
   
    If Result = 1 Then
        Cells(2, 6) = "黒の勝ち"
   
    ElseIf Result = 2 Then
        Cells(2, 6) = "白の勝ち"
   
    ElseIf Result = 3 Then
        Cells(2, 6) = "引き分け"
   
    End If
   
End Sub
 
'勝敗を判定する関数
Function Judge()
 
'    黒が3つ並んでいるか
    If Cells(2, 2) = "●" And Cells(2, 3) = "●" And Cells(2, 4) = "●" Then
        Judge = 1
    ElseIf Cells(3, 2) = "●" And Cells(3, 3) = "●" And Cells(3, 4) = "●" Then
        Judge = 1
    ElseIf Cells(4, 2) = "●" And Cells(4, 3) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 2) = "●" And Cells(3, 2) = "●" And Cells(4, 2) = "●" Then
        Judge = 1
    ElseIf Cells(2, 3) = "●" And Cells(3, 3) = "●" And Cells(4, 3) = "●" Then
        Judge = 1
    ElseIf Cells(2, 4) = "●" And Cells(3, 4) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 2) = "●" And Cells(3, 3) = "●" And Cells(4, 4) = "●" Then
        Judge = 1
    ElseIf Cells(2, 4) = "●" And Cells(3, 3) = "●" And Cells(4, 2) = "●" Then
        Judge = 1
   
'    白が3つ並んでいるか
    ElseIf Cells(2, 2) = "○" And Cells(2, 3) = "○" And Cells(2, 4) = "○" Then
        Judge = 2
    ElseIf Cells(3, 2) = "○" And Cells(3, 3) = "○" And Cells(3, 4) = "○" Then
        Judge = 2
    ElseIf Cells(4, 2) = "○" And Cells(4, 3) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 2) = "○" And Cells(3, 2) = "○" And Cells(4, 2) = "○" Then
        Judge = 2
    ElseIf Cells(2, 3) = "○" And Cells(3, 3) = "○" And Cells(4, 3) = "○" Then
        Judge = 2
    ElseIf Cells(2, 4) = "○" And Cells(3, 4) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 2) = "○" And Cells(3, 3) = "○" And Cells(4, 4) = "○" Then
        Judge = 2
    ElseIf Cells(2, 4) = "○" And Cells(3, 3) = "○" And Cells(4, 2) = "○" Then
        Judge = 2
       
    End If
   
'    黒または白の勝ちの場合
    If Judge = 1 Or Judge = 2 Then
   
'        途中終了
        Exit Function
       
    End If
   
    Dim Gyou, Retu
 
'    空白マスがあるか確認する
    For Gyou = 2 To 4
        For Retu = 2 To 4
       
            If Cells(Gyou, Retu) = "" Then
                Judge = 4
            End If
       
        Next Retu
    Next Gyou
 
'    全てのマスが埋まっている場合
    If Judge <> 4 Then
        Judge = 3
    End If
 
End Function
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?