Подпроцедура Excel

Question

Рассмотрим игру трех игроков. Во время игры каждый игрок бросает по два кубика, и его общая сумма записывается. Затем очки будут начисляться на основании следующих правил:

• Игрок с наибольшим общим количеством наберет 3 очка, игрок с вторым по величине суммарным заработает 1 очко, а игрок, который если он последним, то ничего не заработает.

• Если это ничья между всеми тремя игроками, то каждый игрок заработает 1 очко.

• Если это ничья между двумя лучшими игроками, тогда каждый из них заработает 2 очка, в то время как последний игрок ничего не заработает.

• Если это ничья между двумя нижними игроками, то каждый из них ничего не заработает, а лучший игрок заработает 3 очка.

• Предположим, что кубики представляют собой обычные шестигранные справедливые кубики.

Давайте назовем игроков P1, P2 и P3 соответственно. Напишите подпроцедуру Excel, которая имитирует игру 1000 раз.

Sub Sim()

Call VBA.Randomize

    For i = 1 To 1000
        Cells(i + 1, 1) = i
        For j = 2 To 4
            x = Int(1 + (Rnd * 6))
            y = Int(1 + (Rnd * 6))
            Cells(i + 1, j) = "(" & x & " , " & y & ")"
            Cells(i + 1, j + 3) = x + y
            If Cells(i + 1, j + 3) > Max Then
              Cells(i + 1, j + 3) = "3"
            ElseIf Cells(i + 1, j + 3) < Min Then
              Cells(i + 1, j + 3) = "0"
            ElseIf Cells(i + 1, j + 3) = Min Then
              Cells(i + 1, j + 3) = "1"
            End If
        Next

?????? как продолжить, чтобы получить результаты, как указано ниже:

Ожидаемый результат:

Answer 1

Я бы предложил использовать массив для хранения результатов, а затем использовать полный набор сравнений для определения очков, присужденных каждому игроку. Ниже приведен фрагмент кода, который работает через различные возможные результаты. Я уверен, что это может быть немного упрощено !!

Dim objXLSheet As Worksheet
Dim astrOutput(1 To 3) As String
Dim aintDice(1 To 3) As Integer
Dim aintScore(1 To 3) As Integer
Dim intLoop1 As Integer
Dim intTemp1 As Integer
Dim intTemp2 As Integer

Set objXLSheet = ActiveSheet
Randomize
For intLoop1 = 1 To UBound(aintDice)
    intTemp1 = Int(1 + (Rnd * 6))
    intTemp2 = Int(1 + (Rnd * 6))
    astrOutput(intLoop1) = "(" & intTemp1 & "," & intTemp2 & ")"
    aintDice(intLoop1) = intTemp1 + intTemp2
Next intLoop1
If (aintDice(1) = aintDice(2)) And (aintDice(1) = aintDice(3)) Then '   all three scores are the same
    aintScore(1) = 1: aintScore(2) = 1: aintScore(3) = 1
ElseIf (aintDice(1) > aintDice(2)) And (aintDice(1) > aintDice(3)) Then '   player 1 wins outright
    If aintDice(2) = aintDice(3) Then
        aintScore(1) = 3: aintScore(2) = 0: aintScore(3) = 0
    ElseIf aintDice(2) > aintDice(3) Then
        aintScore(1) = 3: aintScore(2) = 1: aintScore(3) = 0
    ElseIf aintDice(3) > aintDice(2) Then
        aintScore(1) = 3: aintScore(2) = 0: aintScore(3) = 1
    End If
ElseIf (aintDice(2) > aintDice(1)) And (aintDice(2) > aintDice(3)) Then '   player 2 wins outright
    If aintDice(1) = aintDice(3) Then
        aintScore(1) = 0: aintScore(2) = 3: aintScore(3) = 0
    ElseIf aintDice(1) > aintDice(3) Then
        aintScore(1) = 1: aintScore(2) = 3: aintScore(3) = 0
    ElseIf aintDice(3) > aintDice(1) Then
        aintScore(1) = 0: aintScore(2) = 3: aintScore(3) = 1
    End If
ElseIf (aintDice(3) > aintDice(1)) And (aintDice(3) > aintDice(2)) Then '   player 3 wins outright
    If aintDice(1) = aintDice(2) Then
        aintScore(1) = 0: aintScore(2) = 0: aintScore(3) = 3
    ElseIf aintDice(1) > aintDice(2) Then
        aintScore(1) = 1: aintScore(2) = 0: aintScore(3) = 3
    ElseIf aintDice(2) > aintDice(1) Then
        aintScore(1) = 0: aintScore(2) = 1: aintScore(3) = 3
    End If
ElseIf aintDice(1) = aintDice(2) Then   '   players 1 and 2 tie for the win
    aintScore(1) = 2: aintScore(2) = 2: aintScore(3) = 0
ElseIf aintDice(1) = aintDice(3) Then   '   players 1 and 3 tie for the win
    aintScore(1) = 2: aintScore(2) = 0: aintScore(3) = 2
ElseIf aintDice(2) = aintDice(3) Then   '   players 2 and 3 tie for the win
    aintScore(1) = 0: aintScore(2) = 2: aintScore(3) = 2
End If

objXLSheet.Cells(lngGame + 1, 1) = lngGame
For intLoop1 = 1 To UBound(aintDice)
    objXLSheet.Cells(lngGame + 1, 1 + intLoop1) = astrOutput(intLoop1)
    objXLSheet.Cells(lngGame + 1, 4 + intLoop1) = aintScore(intLoop1)
    objXLSheet.Cells(lngGame + 1, 7 + intLoop1) = aintDice(intLoop1)
Next intLoop1

С уважением,