vba实现黑白棋

1.新建Excel

新建Excel，以.xls或.xlsm结尾。

2.确定黑白棋范围及配色

3.实现代码

“重新开始”代码如下：

Sub clearCheckerBoard()
    Range("D4:K11").ClearContents
    Cells(7, 7) = "●"
    Cells(7, 8) = "○"
    Cells(8, 7) = "○"
    Cells(8, 8) = "●"
End Sub

“改变颜色”代码如下：

'改变多个方向的颜色
Sub changeColor(row As Integer, col As Integer)
    '左
    Call changeOneColor(row, col, "左")
    '左上
    Call changeOneColor(row, col, "左上")
    '上
    Call changeOneColor(row, col, "上")
    '右上
    Call changeOneColor(row, col, "右上")
    '右
    Call changeOneColor(row, col, "右")
    '右下
    Call changeOneColor(row, col, "右下")
    '下
    Call changeOneColor(row, col, "下")
    '左下
    Call changeOneColor(row, col, "左下")
End Sub
'改变一个方向的颜色
Sub changeOneColor(row As Integer, col As Integer, flag As String)
    '行列的边界
    Const m As Integer = 4 '行边界
    Const n As Integer = 11 '列边界
    Dim isExist As Boolean '定义标识符
    
    Dim index As Integer '定义数组下标变量
    '定义数组
    Dim arr(7) As Variant
    Dim rcArr(1) As Integer
    
    curr = Cells(row, col)
    If curr = "" Then Exit Sub
    
    index = LBound(arr)
    Select Case flag
        Case "左":
            rStart = row: rEnd = row: rStep = 1
            cStart = col - 1: cEnd = m: cStep = -1
        Case "左上":
            rStart = row - 1: rEnd = m: rStep = -1
            cStart = col - 1: cEnd = m: cStep = -1
        Case "上":
            rStart = row - 1: rEnd = m: rStep = -1
            cStart = col: cEnd = col: cStep = 1
        Case "右上":
            rStart = row - 1: rEnd = m: rStep = -1
            cStart = col + 1: cEnd = n: cStep = 1
        Case "右":
            rStart = row: rEnd = row: rStep = 1
            cStart = col + 1: cEnd = n: cStep = 1
        Case "右下":
            rStart = row + 1: rEnd = n: rStep = 1
            cStart = col + 1: cEnd = n: cStep = 1
        Case "下":
            rStart = row + 1: rEnd = n: rStep = 1
            cStart = col: cEnd = col: cStep = 1
        Case "左下":
            rStart = row + 1: rEnd = n: rStep = 1
            cStart = col - 1: cEnd = m: cStep = -1
    End Select
    '初始化
    Erase arr '清空数组
    isExist = False '是否存在相同的颜色
    For i = rStart To rEnd Step rStep
        Select Case flag
            Case "左":
            Case "左上": cStart = col - row + i: cStep = cEnd - cStart - 1
            Case "上":
            Case "右上": cStart = col + row - i: cStep = cEnd - cStart + 1
            Case "右":
            Case "右下": cStart = col - row + i: cStep = cEnd - cStart + 1
            Case "下":
            Case "左下": cStart = col + row - i: cStep = cEnd - cStart - 1
        End Select
        For j = cStart To cEnd Step cStep
            '符合变色条件的存到数组
            If Cells(i, j) = "" Then
                Erase arr: GoTo here
            ElseIf Cells(i, j) = curr Then
                isExist = True: GoTo here
            Else
                Erase rcArr
                rcArr(0) = i: rcArr(1) = j
                arr(index) = rcArr
                index = index + 1
            End If
        Next j
    Next i
    '变色
here:   If isExist = True Then
            For Each rc In arr
                If IsEmpty(rc) Then
                    Exit For
                Else
                    Cells(rc(0), rc(1)).Locked = False
                    Cells(rc(0), rc(1)) = curr
                    Cells(rc(0), rc(1)).Locked = True
                End If
            Next
        End If
End Sub

“判断输赢”的代码如下：

Sub winAorB()
    '判断输赢
    Dim a, b
    a = 0 '黑棋
    b = 0 '白棋
    For i = 4 To 11
        For j = 4 To 11
            If Cells(i, j) = "●" Then
                a = a + 1
            Else
                b = b + 1
            End If
        Next j
    Next i
    If a > b Then
        MsgBox "黑棋赢！"
    ElseIf a < b Then
        MsgBox "白棋赢！"
    Else
        MsgBox "和棋！"
    End If
End Sub

“工作表事件”【通过点击来交换下棋】的代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static num As Integer
    If Target.row >= 4 And Target.row <= 11 And Target.Column >= 4 And Target.Column <= 11 Then
        num = num + 1
        If num Mod 2 = 1 Then
            Target.Value = "●"
        Else
            Target.Value = "○"
        End If
        Call changeColor(Target.row, Target.Column)

    End If
End Sub