Excel VBA开发War纸牌游戏多次平局动态分配卡牌问题咨询

实现思路 #

• 新增动态数组存储对局累计的所有卡牌（奖池），只要未分出胜负就持续往奖池追加双方新打出的卡牌
• 修正原有代码中随机数生成、牌堆读取的语法错误，补充抽牌后删除原牌堆已打出卡牌的逻辑
• 用循环结构处理连续平局场景，直到双方打出的卡牌数值不等时终止循环，将奖池内所有卡牌全部分配给胜者

完整可运行代码 #

Private Sub Play_Click()
    Dim P1LR As Long, P2LR As Long
    Dim P1CardArr As Variant, P2CardArr As Variant
    Dim P1DrawIdx As Long, P2DrawIdx As Long
    Dim P1PlayVal As Long, P2PlayVal As Long
    Dim prizePool As Variant
    Dim i As Long, winFlag As Integer ' winFlag=1玩家1胜，=2玩家2胜
    
    Randomize ' 初始化随机数种子，避免每次随机结果重复
    ReDim prizePool(0 To 0) ' 初始化奖池
    
    ' 读取双方当前牌堆
    P1LR = Cells(Rows.Count, 1).End(xlUp).Row
    P2LR = Cells(Rows.Count, 2).End(xlUp).Row
    ' 边界判断：任意一方牌数为0直接结束
    If P1LR < 2 Or P2LR < 2 Then
        MsgBox IIf(P1LR < 2, "玩家2获胜！", "玩家1获胜！")
        Exit Sub
    End If
    P1CardArr = Range("A2:A" & P1LR).Value
    P2CardArr = Range("B2:B" & P2LR).Value
    
    ' 循环处理平局，直到分出胜负
    Do
        ' 玩家1随机抽牌
        P1DrawIdx = Int((UBound(P1CardArr, 1) - LBound(P1CardArr, 1) + 1) * Rnd + LBound(P1CardArr, 1))
        P1PlayVal = P1CardArr(P1DrawIdx, 1)
        ' 从玩家1牌堆删除已打出的牌
        For i = P1DrawIdx To UBound(P1CardArr, 1) - 1
            P1CardArr(i, 1) = P1CardArr(i + 1, 1)
        Next
        ReDim Preserve P1CardArr(1 To UBound(P1CardArr, 1) - 1, 1 To 1)
        
        ' 玩家2随机抽牌
        P2DrawIdx = Int((UBound(P2CardArr, 1) - LBound(P2CardArr, 1) + 1) * Rnd + LBound(P2CardArr, 1))
        P2PlayVal = P2CardArr(P2DrawIdx, 1)
        ' 从玩家2牌堆删除已打出的牌
        For i = P2DrawIdx To UBound(P2CardArr, 1) - 1
            P2CardArr(i, 1) = P2CardArr(i + 1, 1)
        Next
        ReDim Preserve P2CardArr(1 To UBound(P2CardArr, 1) - 1, 1 To 1)
        
        ' 两张牌加入奖池
        If UBound(prizePool) > 0 Or prizePool(0) <> Empty Then
            ReDim Preserve prizePool(0 To UBound(prizePool) + 1)
        End If
        prizePool(UBound(prizePool)) = P1PlayVal
        ReDim Preserve prizePool(0 To UBound(prizePool) + 1)
        prizePool(UBound(prizePool)) = P2PlayVal
        
        ' 判断胜负
        If P1PlayVal > P2PlayVal Then
            winFlag = 1
            Exit Do
        ElseIf P2PlayVal > P1PlayVal Then
            winFlag = 2
            Exit Do
        End If
        ' 平局则继续循环，再次抽牌
    Loop While True
    
    ' 展示本轮打出的最后一组牌
    Range("G2").Value = P1PlayVal
    Range("H2").Value = P2PlayVal
    
    ' 奖池卡牌分配给胜者
    If winFlag = 1 Then
        ' 清空原有玩家1牌堆，写入更新后的牌堆+奖池
        Range("A2:A" & P1LR).ClearContents
        For i = 1 To UBound(P1CardArr, 1)
            Cells(i + 1, 1).Value = P1CardArr(i, 1)
        Next
        For i = 0 To UBound(prizePool)
            Cells(UBound(P1CardArr, 1) + 2 + i, 1).Value = prizePool(i)
        Next
    Else
        ' 清空原有玩家2牌堆，写入更新后的牌堆+奖池
        Range("B2:B" & P2LR).ClearContents
        For i = 1 To UBound(P2CardArr, 1)
            Cells(i + 1, 2).Value = P2CardArr(i, 1)
        Next
        For i = 0 To UBound(prizePool)
            Cells(UBound(P2CardArr, 1) + 2 + i, 2).Value = prizePool(i)
        Next
    End If
End Sub

功能说明 #

• 支持任意次数连续平局的自动处理，所有对局期间打出的卡牌都会累计到奖池，最终全部分配给胜者
• 补充了牌堆空了之后的胜负判定逻辑
• 修正了原代码中随机数生成、牌堆操作的语法错误

内容的提问来源于stack exchange，提问作者user58518