-
-
Save Simhyeon/e5c625cde64da3c369287e24acb0fdc1 to your computer and use it in GitHub Desktop.
마비노기 영웅전 강화 시뮬레이션 VBA 소스 코드
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
' Global variables | |
' --- | |
' Probability Table | |
Public probTable As ListObject | |
' Count Table | |
Public countTable As ListObject | |
' Item Db Table | |
Public itemDBTable As ListObject | |
' Target Sheet | |
Public targetSheet As Variant | |
' Full item index | |
Public wholeItemName As String | |
' Restore table prefix | |
Public restorePrefix As String | |
' Set global variables | |
Private Sub SetGlobal(ByVal itemType As String) | |
If LCase(itemType) = "equippment" Then | |
Set countTable = Sheets("방어구 강화").ListObjects("countLog") | |
Set itemDBTable = Sheets("아이템 DB").ListObjects("ItemDBTable") | |
Set probTable = Sheets("방어구 강화").ListObjects("equippment") | |
wholeItemName = "EquippmentFull" | |
Set targetSheet = Sheets("방어구 강화") | |
restorePrefix = "equip_restore_" | |
Else | |
Set countTable = Sheets("무기 강화").ListObjects("countLog2") | |
Set itemDBTable = Sheets("아이템 DB").ListObjects("ItemDBTable") | |
Set probTable = Sheets("무기 강화").ListObjects("weapon") | |
wholeItemName = "WeaponFull" | |
Set targetSheet = Sheets("무기 강화") | |
restorePrefix = "weapon_restore_" | |
End If | |
End Sub | |
' Get Item's price from item db table by item name | |
Private Function GetItemPrice(ByVal itemName As String) As Long | |
Dim row As Variant | |
Set row = itemDBTable.DataBodyRange.Find(What:=itemName, Lookat:=xlWhole) | |
GetItemPrice = itemDBTable.ListRows(row.row - 2).Range(3) | |
End Function | |
' Clear count tables | |
Private Sub ClearCountTable() | |
Dim iListRow As ListRow | |
For Each iListRow In countTable.ListRows | |
iListRow.Range(2).Value = 0 ' try count | |
iListRow.Range(3).Value = 0 ' current stage's cost | |
Next iListRow | |
End Sub | |
Private Function CalculateLinear(ByVal startStage As Integer, ByVal endStage As Integer, ByRef itemBroke As Boolean) As Long | |
' Dynamic (possibly) indices | |
Dim stageIndex As Integer: stageIndex = 1 | |
Dim probIndex As Integer: probIndex = 2 | |
Dim penaltyIndex As Integer: penaltyIndex = 3 | |
Dim goldIndex As Integer: goldIndex = 4 | |
Dim elixirIndex As Integer: elixirIndex = 5 | |
Dim stoneIndex As Integer: stoneIndex = 6 | |
' Local variable | |
Dim currentStage As Integer: currentStage = startStage | |
Dim TotalCost As Long: TotalCost = Range("endCost").Value | |
' Use rune variant | |
Dim useRune As Boolean: useRune = Range("useRune").Value | |
' constant gold cost to be added | |
Dim constant As Long: constant = 0 | |
If useRune Then | |
' Get data from Item DB | |
constant = GetItemPrice("EnhancementRune") | |
End If | |
' Get extra costs | |
Dim elixirCost As Long: elixirCost = GetItemPrice("EnhancementElixir") | |
Dim stoneCost As Long: stoneCost = GetItemPrice("EnhancementStone") | |
' Get Table reference && | |
' Define loop variables | |
Dim count As Integer | |
Dim cost As Long | |
Dim prob As Single | |
Dim penalty As String | |
Dim countCell As Range | |
Dim currentCostCell As Range | |
Dim i As Integer | |
For i = startStage To endStage | |
With probTable.ListRows(i).Range | |
' --- | |
' Set log related Cell's reference | |
Set countCell = countTable.ListRows(i).Range.Cells(2) | |
Set currentCostCell = countTable.ListRows(i).Range.Cells(3) | |
' Get current stage's gold cost and prob from table | |
cost = .Cells(goldIndex) + .Cells(stoneIndex) * stoneCost + .Cells(elixirIndex) * elixirCost | |
prob = .Cells(probIndex) | |
' Increase try count | |
countCell.Value = countCell.Value + 1 | |
' Append total cost | |
TotalCost = TotalCost + cost | |
' Append current count cost | |
currentCostCell.Value = currentCostCell.Value + cost | |
' Try until success | |
' Rnd is bigger than target probabilty | |
' THis means failure | |
While rnd() > prob | |
' Append costs | |
TotalCost = TotalCost + cost + constant | |
currentCostCell.Value = currentCostCell.Value + constant + cost | |
' Increase count by 1 | |
countCell.Value = countCell.Value + 1 | |
' Check if rune is used or not | |
If Not useRune Then | |
' If rune is not used, check for penalty. | |
penalty = LCase(.Cells(penaltyIndex)) | |
Select Case penalty | |
Case "impotent" | |
' Needs to make a whole item again | |
' Get whole item cost from DB | |
Dim itemCost As Long: itemCost = GetItemPrice(wholeItemName) | |
' Early Return | |
CalculateLinear = TotalCost + itemCost | |
currentCostCell.Value = currentCostCell.Value + itemCost | |
itemBroke = True | |
Exit Function | |
Case "reset" | |
' No need to make a whole item | |
' Early return | |
CalculateLinear = TotalCost | |
itemBroke = True | |
Exit Function | |
Case "Decline" | |
' This is theoritically ok, but can be unintended in false input | |
i = i - 2 | |
Case Else | |
End Select | |
End If | |
Wend | |
' Increase current Stage | |
currentStage = currentStage + 1 | |
' --- | |
End With | |
Next i | |
' Item is intact | |
itemBroke = False | |
' Return total cost | |
CalculateLinear = TotalCost | |
End Function | |
Private Function CalculateNonLinear(ByVal endIndex As Integer) As Long | |
' Dynamic indices | |
Dim stageIndex As Integer: stageIndex = 1 | |
Dim probIndex As Integer: probIndex = 2 | |
Dim penaltyIndex As Integer: penaltyIndex = 3 | |
Dim goldIndex As Integer: goldIndex = 4 | |
Dim elixirIndex As Integer: elixirIndex = 5 | |
Dim stoneIndex As Integer: stoneIndex = 6 | |
' Get Table reference | |
Dim costRow As ListRow | |
Dim restoreTable As ListObject | |
' Define costs | |
Dim costGold As Long: costGold = 0 | |
Dim elixirCost As Long: elixirCost = GetItemPrice("EnhancementElixir") | |
Dim stoneCost As Long: stoneCost = GetItemPrice("EnhancementStone") | |
Dim steelCost As Long: steelCost = GetItemPrice("DamascusSteel") | |
Dim runeCost As Long: runeCost = GetItemPrice("EnhancementRune") | |
' Declare probabilities | |
Dim prob As Single: prob = 0 | |
Dim bonusProb As Single: bonusProb = 0 | |
Dim tryCount As Integer: tryCount = 0 | |
' Log related references | |
Dim countCell As Range | |
Dim currentCostCell As Range | |
Dim currentCost As Long: currentCost = 0 | |
' Random number to use for calculation | |
Dim rndNum As Single: rndNum = 0 | |
Dim i As Integer | |
For i = 10 To endIndex - 1 | |
' Initiate try Count | |
tryCount = 1 | |
' Get reference for restore related table | |
Set restoreTable = targetSheet.ListObjects(restorePrefix & i) | |
' Get current probability value from probTable | |
prob = probTable.ListRows(i).Range(2) | |
With probTable.ListRows(i) | |
' --- | |
' Set log related celss reference | |
Set countCell = countTable.ListRows(i).Range.Cells(2) | |
Set currentCostCell = countTable.ListRows(i).Range.Cells(3) | |
' Get random value | |
rndNum = rnd() | |
' Calculate current Cost of enhancement | |
currentCost = .Range(goldIndex) + .Range(stoneIndex) * stoneCost + .Range(elixirIndex) * elixirCost | |
' Update log | |
costGold = costGold + currentCost | |
currentCostCell.Value = currentCostCell.Value + currentCost | |
' If success | |
If rndNum <= prob Then | |
countCell.Value = 1 ' Set count to 1 | |
' If failed | |
Else | |
' Try until success | |
While rndNum > prob + bonusProb | |
' Add steel money to total cost and current cost | |
currentCost = restoreTable.ListRows(tryCount).Range(3).Value * steelCost + runeCost | |
costGold = costGold + currentCost | |
currentCostCell.Value = currentCostCell.Value + currentCost | |
' Increase try count | |
tryCount = tryCount + 1 | |
' Update Count in log | |
countCell.Value = tryCount | |
' Check if guarnateed enhancment is triggered | |
' If triggered, set rndNum to 0 | |
If tryCount = restoreTable.ListRows.count Then | |
rndNum = 0 | |
Else | |
rndNum = rnd() | |
End If | |
Wend | |
End If | |
' --- | |
End With | |
Next i | |
' Return total cost Gold | |
CalculateNonLinear = costGold | |
End Function | |
Private Sub PrintErrors(ByVal startIndex As Integer, ByVal endIndex As Integer, ByRef earlyReturn As Boolean) | |
If startIndex < 0 Or startIndex > 15 Then | |
MsgBox "Start index should be bigger than 0 and smaller than 15 but given : " & startIndex | |
earlyReturn = True | |
Exit Sub | |
End If | |
If endIndex < 0 Or endIndex > 15 Then | |
MsgBox "End index should be bigger than 0 and smaller than 15 but given : " & endIndex | |
earlyReturn = True | |
Exit Sub | |
End If | |
If startIndex >= endIndex Then | |
MsgBox "Start index should be smaller than endIndex but given : " & startIndex & " and : " & endIndex & ", for each index." | |
earlyReturn = True | |
Exit Sub | |
End If | |
End Sub | |
Private Sub Calculate_Expected_Cost(ByVal itemType As String) | |
' Set global data source references | |
SetGlobal itemType | |
' Set user inputs from worksheets | |
Dim startStage As Variant: startStage = Range("StartStage").Value | |
Dim endStage As Variant: endStage = Range("EndStage").Value | |
Dim earlyReturn As Boolean: earlyReturn = False | |
Dim endCost As Long: endCost = 0 | |
' Print erros if user input is not valid | |
PrintErrors startStage, endStage, earlyReturn | |
' Early return if errors | |
If earlyReturn Then | |
Exit Sub | |
End If | |
' Clear count table | |
ClearCountTable | |
' Clear Cost | |
Range("endCost").Value = 0 | |
' Firstly the calcuation has to decide whether it is within simple calculation or | |
' within complex calcuation | |
Dim linearEnd As Integer | |
If endStage >= 10 Then | |
linearEnd = 10 | |
Else | |
linearEnd = endStage | |
End If | |
' Enhancement for range between 1 ~ 10 | |
If startStage < 10 Then | |
' Call function | |
Dim itemBroke As Boolean: itemBroke = True | |
While itemBroke | |
endCost = CalculateLinear(startStage, linearEnd, itemBroke) | |
Range("endCost").Value = endCost | |
Wend | |
End If | |
' Enhancement for range between 11 ~ 15 | |
If endStage > 10 Then | |
endCost = endCost + CalculateNonLinear(endStage) | |
End If | |
' Update final end cost | |
Range("endCost").Value = endCost | |
End Sub | |
' Exposed subprocedure | |
Sub Calculate_equippment_cost() | |
Calculate_Expected_Cost "equippment" | |
End Sub | |
' Exposed subprocedure | |
Sub Calculate_weapon_cost() | |
Calculate_Expected_Cost "weapon" | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment