Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Sub simulasi()
Dim posisi(4) As Integer
Dim hitung(40) As Integer
Dim maks(40) As Integer
Dim roll_dice As Integer
Dim iter As Double
Dim tes As Integer
Dim jail_stat(4) As Integer
tes = Cells(2, 3)
'Loop Test
Do Until ulang = tes
'//Initial location
For a = 1 To 4
posisi(a) = 1
hitung(posisi(a)) = hitung(posisi(a)) + 1
Cells(8, 6) = hitung(posisi(a))
If hitung(posisi(a)) > maks(posisi(a)) Then
maks(posisi(a)) = hitung(posisi(a))
End If
Next
iter = Cells(3, 3) 'count iteration
'//Main loop
For i = 1 To iter
For j = 1 To 4
'one trial per player
dice = WorksheetFunction.RandBetween(1, 36)
roll_dice = Sheet4.Cells(4, 1 + dice)
hitung(posisi(j)) = hitung(posisi(j)) - 1 'leaving a previous tile
Cells(8, 5 + posisi(j)) = hitung(posisi(j)) 'update qty previous tiles
If (posisi(j) + roll_dice) <> 40 Then
posisi(j) = (posisi(j) + roll_dice) Mod 40 'move as much as rolled dice
Else
posisi(j) = posisi(j) + roll_dice
End If
'//Jail checkpoint
If jail_stat(j) > 0 Then 'if hit go to jail of currently being skip
jail_stat(j) = jail_stat(j) - 1
posisi(j) = 11
hitung(posisi(j)) = hitung(posisi(j)) + 1
Cells(8, 5 + posisi(j)) = hitung(posisi(j)) 'must update again due to hold
ElseIf (posisi(j) + roll_dice) = 31 Then
posisi(j) = 11 'keep in jail :p
jail_stat(j) = 3 'skipped to three times
hitung(posisi(j)) = hitung(posisi(j)) + 1 'placing a new tile/calculate hit
Cells(8, 5 + posisi(j)) = hitung(posisi(j)) 'show hit counting
Cells(10, 5 + posisi(j)) = Cells(10, 5 + posisi(j)) + 1 'count hit
Else
hitung(posisi(j)) = hitung(posisi(j)) + 1 'placing a new tile/calculate hit
Cells(8, 5 + posisi(j)) = hitung(posisi(j))
Cells(10, 5 + posisi(j)) = Cells(10, 5 + posisi(j)) + 1 'count hit
End If
'//Placing a new maximum variable
If hitung(posisi(j)) > maks(posisi(j)) Then
maks(posisi(j)) = hitung(posisi(j))
End If
Cells(11, 5 + posisi(j)) = maks(posisi(j)) 'write
Next
Cells(4, 3) = Cells(4, 3) + 1 'update runtime
Next
ulang = ulang + 1 'update satu session abis
'Copy paste data
roww = ulang + 2
Application.ScreenUpdating = False
Sheet1.Range("F10:AS10").Copy
Sheet2.Range("C" & roww & ":AP" & roww).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet1.Range("F11:AS11").Copy
Sheet2.Range("AR" & roww & ":CE" & roww).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet1.Range("F10:AS11").ClearContents
'clear runtime and update test
Sheet1.Cells(4, 3) = ""
Sheet1.Cells(2, 4) = ulang
Application.ScreenUpdating = True
Loop
Sheet1.Range("F8:AS8").ClearContents
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment