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
