Untitled

Option Explicit

Sub A1sim()

Dim numpull As Long
Dim numsimul As Long
Dim i As Long
Dim j As Long
Dim k As Integer
Dim min As Long
Dim max As Long
Dim A_prob As Double
Dim S_prob As Double
Dim total_prob As Double
Dim got_S As Integer

Dim Start As Single
Dim Runtime As Single
Dim ElapsedTime As String


numsimul = InputBox("Number of simulations to run")
S_prob = 1.5
A_prob = 13.5
total_prob = A_prob + S_prob '15
got_S = 0

Start = Timer


Range("A2:Z1000000").ClearContents
numpull = 0


Application.ScreenUpdating = False
For j = 1 To numsimul
    Range("A2:C1000000").ClearContents
    numpull = 0
    got_S = 0

    i = 1
    Do While numpull = 0
    Cells(i + 1, 1) = "=RAND()"
    Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
    Cells(i + 1, 2).Value = 0
    'general
    If Cells(i + 1, 1).Value <= total_prob Then
        Cells(i + 1, 2).Value = 1
    End If
    If Cells(i + 1, 1).Value <= S_prob Then
        Cells(i + 1, 3) = "S!"
        numpull = i
    End If
    '10 guarantee
    If i >= 10 And Cells(i + 1, 1).Value > total_prob Then
        If Excel.WorksheetFunction.Sum(Range(Cells(i - 8, 2), Cells(i, 2))) = 0 Then
            'here we're assuming that on the guarantee, the chances to get S rank vs A rank are proportional to listed rates
            Cells(i + 1, 1) = "=RAND()"
            Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
            Cells(i + 1, 2).Value = 1
            If Cells(i + 1, 1).Value <= S_prob / total_prob * 100 Then
                Cells(i + 1, 3) = "S!(g)"
                numpull = i
            End If
        End If
    End If
    '100 guarantee
    If i >= 100 Then
        If Excel.WorksheetFunction.CountA(Range(Cells(i - 98, 3), Cells(i, 3))) = 0 Then
            Cells(i + 1, 3) = "S!(100g)"
            numpull = i
        End If
    End If

    i = i + 1
    Loop
    Cells(j + 1, 4).Value = numpull
Next j


min = WorksheetFunction.min(Range(Cells(2, 4), Cells(2 + numsimul, 4)))
max = WorksheetFunction.max(Range(Cells(2, 4), Cells(2 + numsimul, 4)))

k = 1
Cells(k + 1, 6) = min
Cells(k + 1, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), min)

Do
    Cells(k + 2, 6) = Cells(k + 1, 6) + 1
    Cells(k + 2, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), Cells(k + 2, 6).Value)
    k = k + 1
Loop Until k >= max - min + 1

Application.ScreenUpdating = True
Runtime = Timer - Start
MsgBox (Runtime)


End Sub

Sub A2sim()

Dim numpull As Long
Dim numsimul As Long
Dim i As Long
Dim j As Long
Dim k As Integer
Dim min As Long
Dim max As Long
Dim A_prob As Double
Dim S_prob As Double
Dim total_prob As Double
Dim got_S As Integer

Dim Start As Single
Dim Runtime As Single
Dim ElapsedTime As String


numsimul = InputBox("Number of simulations to run")
S_prob = 1.5
A_prob = 13.5
total_prob = A_prob + S_prob '15
got_S = 0

Start = Timer


Range("A2:Z1000000").ClearContents
numpull = 0


Application.ScreenUpdating = False
For j = 1 To numsimul
    Range("A2:C1000000").ClearContents
    numpull = 0
    got_S = 0

    i = 1
    Do While numpull = 0
    Cells(i + 1, 1) = "=RAND()"
    Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
    Cells(i + 1, 2).Value = 0
    'general
    If Cells(i + 1, 1).Value <= total_prob Then
        Cells(i + 1, 2).Value = 1
    End If
    If Cells(i + 1, 1).Value <= S_prob Then
        Cells(i + 1, 3) = "S!"
        numpull = i
    End If
    '10 guarantee
    If i >= 10 And Cells(i + 1, 1).Value > total_prob Then
        If Excel.WorksheetFunction.Sum(Range(Cells(i - 8, 2), Cells(i, 2))) = 0 Then
            'here we're assuming that on the guarantee, the chances to get S rank vs A rank are proportional to the number of valks in the pool (1 S, 4 A rank)
            Cells(i + 1, 1) = "=RAND()"
            Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
            Cells(i + 1, 2).Value = 1
            If Cells(i + 1, 1).Value <= 1 / 5 * 100 Then
                Cells(i + 1, 3) = "S!(g)"
                numpull = i
            End If
        End If
    End If
    '100 guarantee
    If i >= 100 Then
        If Excel.WorksheetFunction.CountA(Range(Cells(i - 98, 3), Cells(i, 3))) = 0 Then
            Cells(i + 1, 3) = "S!(100g)"
            numpull = i
        End If
    End If

    i = i + 1
    Loop
    Cells(j + 1, 4).Value = numpull
Next j


min = WorksheetFunction.min(Range(Cells(2, 4), Cells(2 + numsimul, 4)))
max = WorksheetFunction.max(Range(Cells(2, 4), Cells(2 + numsimul, 4)))

k = 1
Cells(k + 1, 6) = min
Cells(k + 1, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), min)

Do
    Cells(k + 2, 6) = Cells(k + 1, 6) + 1
    Cells(k + 2, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), Cells(k + 2, 6).Value)
    k = k + 1
Loop Until k >= max - min + 1

Application.ScreenUpdating = True
Runtime = Timer - Start
MsgBox (Runtime)


End Sub

Sub A3sim()

Dim numpull As Long
Dim numsimul As Long
Dim i As Long
Dim j As Long
Dim k As Integer
Dim min As Long
Dim max As Long
Dim A_prob As Double
Dim S_prob As Double
Dim total_prob As Double
Dim got_S As Integer

Dim Start As Single
Dim Runtime As Single
Dim ElapsedTime As String


numsimul = InputBox("Number of simulations to run")
S_prob = 1.5
A_prob = 13.5
total_prob = A_prob + S_prob '15
got_S = 0

Start = Timer


Range("A2:Z1000000").ClearContents
numpull = 0


Application.ScreenUpdating = False
For j = 1 To numsimul
    Range("A2:C1000000").ClearContents
    numpull = 0
    got_S = 0

    i = 1
    Do While numpull = 0
    Cells(i + 1, 1) = "=RAND()"
    Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
    Cells(i + 1, 2).Value = 0
    'general
    If Cells(i + 1, 1).Value <= total_prob Then
        Cells(i + 1, 2).Value = 1
    End If
    If Cells(i + 1, 1).Value <= S_prob Then
        Cells(i + 1, 3) = "S!"
        numpull = i
    End If
    '10 guarantee
    If i >= 10 And Cells(i + 1, 1).Value > total_prob Then
        If Excel.WorksheetFunction.Sum(Range(Cells(i - 8, 2), Cells(i, 2))) = 0 Then
            'here we're assuming that on the guarantee, the chances to get S rank vs A rank are equal to the listed rates (i.e. 1.5% for S, 98.5% for A)
            Cells(i + 1, 1) = "=RAND()"
            Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
            Cells(i + 1, 2).Value = 1
            If Cells(i + 1, 1).Value <= S_prob Then
                Cells(i + 1, 3) = "S!(g)"
                numpull = i
            End If
        End If
    End If
    '100 guarantee
    If i >= 100 Then
        If Excel.WorksheetFunction.CountA(Range(Cells(i - 98, 3), Cells(i, 3))) = 0 Then
            Cells(i + 1, 3) = "S!(100g)"
            numpull = i
        End If
    End If

    i = i + 1
    Loop
    Cells(j + 1, 4).Value = numpull
Next j


min = WorksheetFunction.min(Range(Cells(2, 4), Cells(2 + numsimul, 4)))
max = WorksheetFunction.max(Range(Cells(2, 4), Cells(2 + numsimul, 4)))

k = 1
Cells(k + 1, 6) = min
Cells(k + 1, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), min)

Do
    Cells(k + 2, 6) = Cells(k + 1, 6) + 1
    Cells(k + 2, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), Cells(k + 2, 6).Value)
    k = k + 1
Loop Until k >= max - min + 1

Application.ScreenUpdating = True
Runtime = Timer - Start
MsgBox (Runtime)


End Sub

Sub B3sim()

Dim numpull As Long
Dim numsimul As Long
Dim i As Long
Dim j As Long
Dim k As Integer
Dim min As Long
Dim max As Long
Dim A_prob As Double
Dim S_prob As Double
Dim total_prob As Double
Dim got_S As Integer

Dim Start As Single
Dim Runtime As Single
Dim ElapsedTime As String


numsimul = InputBox("Number of simulations to run")
S_prob = 1.5 * 0.5
A_prob = 13.5 * 0.5
total_prob = A_prob + S_prob '15
got_S = 0

Start = Timer


Range("A2:Z1000000").ClearContents
numpull = 0


Application.ScreenUpdating = False
For j = 1 To numsimul
    Range("A2:C1000000").ClearContents
    numpull = 0
    got_S = 0

    i = 1
    Do While numpull = 0
    Cells(i + 1, 1) = "=RAND()"
    Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
    Cells(i + 1, 2).Value = 0
    'general
    If Cells(i + 1, 1).Value <= total_prob Then
        Cells(i + 1, 2).Value = 1
    End If
    If Cells(i + 1, 1).Value <= S_prob Then
        Cells(i + 1, 3) = "S!"
        numpull = i
    End If
    '10 guarantee
    If i >= 10 And Cells(i + 1, 1).Value > total_prob Then
        If Excel.WorksheetFunction.Sum(Range(Cells(i - 8, 2), Cells(i, 2))) = 0 Then
            'here we're assuming that on the guarantee, the chances to get S rank vs A rank are equal to the listed rates (i.e. 1.5% for S, 98.5% for A)
            Cells(i + 1, 1) = "=RAND()"
            Cells(i + 1, 1).Value = Cells(i + 1, 1).Value * 100
            Cells(i + 1, 2).Value = 1
            If Cells(i + 1, 1).Value <= S_prob Then
                Cells(i + 1, 3) = "S!(g)"
                numpull = i
            End If
        End If
    End If
    '100 guarantee
    If i >= 100 Then
        If Excel.WorksheetFunction.CountA(Range(Cells(i - 98, 3), Cells(i, 3))) = 0 Then
            Cells(i + 1, 3) = "S!(100g)"
            numpull = i
        End If
    End If

    i = i + 1
    Loop
    Cells(j + 1, 4).Value = numpull
Next j


min = WorksheetFunction.min(Range(Cells(2, 4), Cells(2 + numsimul, 4)))
max = WorksheetFunction.max(Range(Cells(2, 4), Cells(2 + numsimul, 4)))

k = 1
Cells(k + 1, 6) = min
Cells(k + 1, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), min)

Do
    Cells(k + 2, 6) = Cells(k + 1, 6) + 1
    Cells(k + 2, 7) = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(2 + numsimul, 4)), Cells(k + 2, 6).Value)
    k = k + 1
Loop Until k >= max - min + 1

Application.ScreenUpdating = True
Runtime = Timer - Start
MsgBox (Runtime)


End Sub