Create a gist now

Instantly share code, notes, and snippets.

Embed
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