【小游戏】在Excel中玩猜数字游戏(进阶版

Option Explicit' 主游戏过程Sub PlayGame()    Dim secret As String          ' 秘密数字    Dim guess As String            ' 玩家猜测    Dim A As Integer, B As Integer ' 反馈的A和B数量    Dim guessCount As Integer      ' 猜测次数    Dim ws As Worksheet            ' 用于记录的工作表    Dim again As Integer           ' 是否再玩一次的选择    ' 指定记录工作表（可根据需要修改为 "Sheet1" 或其他名称）    Set ws = ThisWorkbook.Sheets("Sheet1")    ' 清空A列并写入标题    ws.Columns(1).ClearContents    ws.Cells(1, 1).Value = "猜测历史（猜测 -> 反馈）"    ' 生成四位不重复的秘密数字    secret = GenerateSecret    ' 可选的调试输出（正式使用时请注释掉）    ' Debug.Print "秘密数字（仅供调试）: " & secret    ' 显示游戏规则    MsgBox "游戏开始！已生成一个四位不重复数字（0-9）。" & vbCrLf & _           "每次输入四位数字，将得到 XAYB 的反馈：" & vbCrLf & _           "X = 数字正确且位置正确" & vbCrLf & _           "Y = 数字正确但位置错误" & vbCrLf & _           "直到出现 4A0B 即为胜利。", vbInformation, "猜数字游戏"    guessCount = 0    ' 主循环：反复获取猜测直到猜对或用户取消    Do        guess = GetGuess(ws)   ' 获取玩家输入（取消时返回空字符串）        If guess = "" Then     ' 用户取消输入，退出游戏            MsgBox "游戏已退出。", vbExclamation, "退出"            Exit Do        End If        guessCount = guessCount + 1        ' 计算本次猜测的A和B        CalculateAB secret, guess, A, B        ' 将猜测记录写入工作表（从第2行开始）        ws.Cells(guessCount + 1, 1).Value = guess & " -> " & A & "A" & B & "B"        ' 判断是否完全猜对        If A = 4 Then            MsgBox "恭喜！你猜对了！秘密数字是 " & secret & vbCrLf & _                   "总猜测次数: " & guessCount, vbInformation, "胜利"            ' 询问是否再玩一局            again = MsgBox("再玩一次？", vbYesNo + vbQuestion, "继续")            If again = vbYes Then                PlayGame   ' 重新开始游戏（递归调用）                Exit Sub   ' 结束当前实例，避免返回原循环            Else                MsgBox "感谢游玩！", vbInformation, "结束"                Exit Sub            End If        End If    LoopEnd Sub' 生成四位不重复的随机数字字符串（例如 "0123"）Function GenerateSecret() As String    Dim digits(0 To 9) As Integer  ' 存放0-9的数字    Dim i As Integer, j As Integer    Dim temp As Integer    Dim result As String    ' 初始化数组    For i = 0 To 9        digits(i) = i    Next i    ' 随机打乱数组（Fisher-Yates洗牌算法）    Randomize    For i = 0 To 9        j = Int((9 - i + 1) * Rnd + i)  ' 随机位置 i~9        temp = digits(i)        digits(i) = digits(j)        digits(j) = temp    Next i    ' 取前四个数字拼接成字符串    result = ""    For i = 0 To 3        result = result & CStr(digits(i))    Next i    GenerateSecret = resultEnd Function' 获取玩家输入，并进行有效性验证（必须为4位数字）' 返回有效猜测字符串，如果用户取消则返回空字符串Function GetGuess(ws As Worksheet) As String    Dim inputStr As String    Dim i As Integer    Dim valid As Boolean    Do        ' 使用 InputBox 获取输入（取消返回空字符串）        inputStr = InputBox("请输入四位数字（例如 0123）：", "猜数字游戏")        ' 如果用户取消，返回空字符串        If inputStr = "" Then            GetGuess = ""            Exit Function        End If        ' 去除前后空格        inputStr = Trim(inputStr)        ' 检查长度是否为4        If Len(inputStr) <> 4 Then            MsgBox "必须输入4位数字！", vbExclamation, "输入错误"            valid = False        Else            valid = True            ' 检查每一位是否都是数字字符            For i = 1 To 4                If Not (Mid(inputStr, i, 1) Like "#") Then                    valid = False                    Exit For                End If            Next i            If Not valid Then                MsgBox "只能包含数字（0-9）！", vbExclamation, "输入错误"            End If        End If    Loop Until valid    GetGuess = inputStrEnd Function' 计算猜测与秘密数字的A和B' secret: 秘密数字字符串（4位）' guess: 猜测数字字符串（4位）' A: 返回数字和位置都正确的个数' B: 返回数字正确但位置错误的个数Sub CalculateAB(secret As String, guess As String, ByRef A As Integer, ByRef B As Integer)    Dim i As Integer, j As Integer    Dim secretChars(1 To 4) As String   ' 秘密数字各位字符    Dim guessChars(1 To 4) As String    ' 猜测数字各位字符    Dim matchedSecret(1 To 4) As Boolean ' 标记秘密数字的某位是否已被匹配（A或B）    ' 初始化数组    For i = 1 To 4        secretChars(i) = Mid(secret, i, 1)        guessChars(i) = Mid(guess, i, 1)        matchedSecret(i) = False    Next i    A = 0    B = 0    ' 第一步：计算 A（位置和数字全对）    For i = 1 To 4        If secretChars(i) = guessChars(i) Then            A = A + 1            matchedSecret(i) = True   ' 标记该位已被匹配（用于B的计算）        End If    Next i    ' 第二步：计算 B（数字对但位置错）    ' 遍历猜测中未匹配A的位置，检查该数字是否出现在秘密中未匹配的位置    For i = 1 To 4        ' 只考虑当前猜测位不是A的情况        If secretChars(i) <> guessChars(i) Then            For j = 1 To 4                ' 秘密位未被匹配，且数字与猜测位相同                If Not matchedSecret(j) And guessChars(i) = secretChars(j) Then                    B = B + 1                    matchedSecret(j) = True   ' 标记该秘密位已用于B，避免重复计数                    Exit For                End If            Next j        End If    Next iEnd Sub