VBA西北人摇色子模拟

Visual Basic for Applications 2021-10-26

主要模拟以下场景:
庄稼:3个不知道
对家:揭开
看以下庄稼赢的概率
1.gif

Option Explicit

Sub 再来一把_Click()
    '随机生成点数
    Dim tmp(6) As Variant
    
    tmp(0) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B3").Formula = "=UNICHAR(" & (tmp(0) + 9855) & ")"
    
    tmp(1) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B4").Formula = "=UNICHAR(" & (tmp(1) + 9855) & ")"
    
    tmp(2) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B5").Formula = "=UNICHAR(" & (tmp(2) + 9855) & ")"
    
    tmp(3) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D3").Formula = "=UNICHAR(" & (tmp(3) + 9855) & ")"
    
    tmp(4) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D4").Formula = "=UNICHAR(" & (tmp(4) + 9855) & ")"
    
    tmp(5) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D5").Formula = "=UNICHAR(" & (tmp(5) + 9855) & ")"
    
    '排序,从小到到
    Dim i, j, t As Integer
    For i = 0 To 5
        For j = 0 To 5
            If tmp(i) > tmp(j) Then
                t = tmp(i)
                tmp(i) = tmp(j)
                tmp(j) = t
            End If
        Next
    Next
    
    'Worksheets("sheet1").Range("K2:P2") = tmp
    
    Dim h1 As Integer
    h1 = 0
    For i = 5 To 0 Step -1
        If tmp(i) = 1 Then
            h1 = h1 + 1
        End If
    Next
        
    If h1 >= 2 Then
        Worksheets("sheet1").Range("B6") = "胜"
        Worksheets("sheet1").Range("D6") = "负"
    ElseIf h1 = 1 Then
        If (tmp(5) = tmp(4) Or tmp(4) = tmp(3) Or tmp(3) = tmp(2) Or tmp(2) = tmp(1)) Then
            Worksheets("sheet1").Range("B6") = "胜"
            Worksheets("sheet1").Range("D6") = "负"
        Else
            Worksheets("sheet1").Range("B6") = "负"
            Worksheets("sheet1").Range("D6") = "胜"
        End If
    Else
        If (tmp(5) = tmp(4) And tmp(4) = tmp(3)) Or (tmp(4) = tmp(3) And tmp(3) = tmp(2)) Or (tmp(3) = tmp(2) And tmp(2) = tmp(1)) Or (tmp(2) = tmp(1) And tmp(1) = tmp(0)) Then
            Worksheets("sheet1").Range("B6") = "胜"
            Worksheets("sheet1").Range("D6") = "负"
        Else
            Worksheets("sheet1").Range("B6") = "负"
            Worksheets("sheet1").Range("D6") = "胜"
        End If
    End If
        
    If Worksheets("sheet1").Range("B6") = "胜" Then
        Worksheets("sheet1").Range("B7") = Worksheets("sheet1").Range("B7") + 1
    Else
        Worksheets("sheet1").Range("D7") = Worksheets("sheet1").Range("D7") + 1
    End If
    
    'Worksheets("sheet1").Range("B6") = "胜"
    'Worksheets("sheet1").Range("D6") = "负"
End Sub
Sub 重置_Click()
    Worksheets("sheet1").Range("B6") = ""
    Worksheets("sheet1").Range("D6") = ""
    
    Worksheets("sheet1").Range("B7") = 0
    Worksheets("sheet1").Range("D7") = 0
    
End Sub

文件下载:摇色子.zip

知识共享署名声明
本文由 herokay 创作,采用 知识共享署名 3.0,可自由转载、引用,但需署名作者且注明文章出处。

还不快抢沙发

添加新评论