마비노기 영웅전 강화 시뮬레이션 VBA 소스 코드

vin_enhance.vba

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