VBA功能正常工作，但導致Excel崩潰

Question

我正在做一個遊戲練習我的編碼的Excel表，因爲我上次使用VBA已經兩年了，而且我的訓練很基礎。如果你不介意看我的代碼，並給我一個可能發生的事情的想法，我將不勝感激。對於代碼的重複性抱歉。下面是代碼的功能和代碼本身的描述。

基本上，我正在閱讀C9：G9中視頻遊戲角色的每個天賦的內容。它會讀取每一個以查看它是否與用戶選擇的類別相符，如果它符合，那麼它將獲得與C10：G10中的天賦相關的稀有性。獲得該信息後，它使用索引函數從另一張表中讀取包含與天賦類別和人才稀缺程度相關的百分比（例如「Common Defense」）的值。通過首先搜索按字母順序排序的天賦列表（行值），然後按照從C10：G10指示的稀有度來分配列值來決定行列索引值。

該代碼似乎正在執行我想要的方式，但每當我嘗試將此函數向下拖動幾行excel時，它會導致程序凍結並崩潰。

Function TalentCalc(category As String) As Single 

Application.Volatile 

Dim Rarity As String 
Dim TableVal As Single 
Dim CategoryRow As Single 
Dim RarityCol As Single 

For i = 1 To 12 Step 1 
    If category = Cells(3 + i, "M") Then 
     CategoryRow = i 
     i = 11 
    End If 
Next i 


If Cells(9, "C") = category Then 
    Rarity = Cells(10, "C") 
    If Rarity = "Common" Then 
     RarityCol = 1 
    ElseIf Rarity = "Rare" Then 
     RarityCol = 2 
    ElseIf Rarity = "Epic" Then 
     RarityCol = 3 
    Else 
     MsgBox ("Pick a rarity.") 
    End If 

    TableVal = WorksheetFunction.Index(Worksheets("Talents").Range("B2:D13"), CategoryRow, RarityCol) 
    TalentCalc = TalentCalc + TableVal 
End If 

If Cells(9, "D") = category Then 
    Rarity = Cells(10, "D") 
    If Rarity = "Common" Then 
     RarityCol = 1 
    ElseIf Rarity = "Rare" Then 
     RarityCol = 2 
    ElseIf Rarity = "Epic" Then 
     RarityCol = 3 
    Else 
     MsgBox ("Pick a rarity.") 
    End If 

    TableVal = WorksheetFunction.Index(Worksheets("Talents").Range("B2:D13"), CategoryRow, RarityCol) 
    TalentCalc = TalentCalc + TableVal 
End If 

If Cells(9, "E") = category Then 
    Rarity = Cells(10, "E") 
    If Rarity = "Common" Then 
     RarityCol = 1 
    ElseIf Rarity = "Rare" Then 
     RarityCol = 2 
    ElseIf Rarity = "Epic" Then 
     RarityCol = 3 
    Else 
     MsgBox ("Pick a rarity.") 
    End If 

    TableVal = WorksheetFunction.Index(Worksheets("Talents").Range("B2:D13"), CategoryRow, RarityCol) 
    TalentCalc = TalentCalc + TableVal 
End If 

If Cells(9, "F") = category Then 
    Rarity = Cells(10, "F") 
    If Rarity = "Common" Then 
     RarityCol = 1 
    ElseIf Rarity = "Rare" Then 
     RarityCol = 2 
    ElseIf Rarity = "Epic" Then 
     RarityCol = 3 
    Else 
     MsgBox ("Pick a rarity.") 
    End If 

    TableVal = WorksheetFunction.Index(Worksheets("Talents").Range("B2:D13"), CategoryRow, RarityCol) 
    TalentCalc = TalentCalc + TableVal 
End If 

If Cells(9, "G") = category Then 
    Rarity = Cells(10, "G") 
    If Rarity = "Common" Then 
     RarityCol = 1 
    ElseIf Rarity = "Rare" Then 
     RarityCol = 2 
    ElseIf Rarity = "Epic" Then 
     RarityCol = 3 
    Else 
     MsgBox ("Pick a rarity.") 
    End If 

    TableVal = WorksheetFunction.Index(Worksheets("Talents").Range("B2:D13"), CategoryRow, RarityCol) 
    TalentCalc = TalentCalc + TableVal 
End If 

End Function 

Answer 1

代碼簡化：

Function TalentCalc(category As String) As Single 
'should not need this, but uncomment if you really want it 
'Application.Volatile 

Dim Rarity As String 
Dim TableVal As Single 
Dim CategoryRow As Long 
Dim RarityCol As Long 
Dim ws As Worksheet 

Set ws = Worksheets("Sheet1") 'Change to your worksheet 

CategoryRow = 0: RarityCol = 0 
On Error Resume Next 
    CategoryRow = Application.WorksheetFunction.Match(category, ws.Range("M:M"), 0)-3 
    RarityCol = Application.WorksheetFunction.Match(category, ws.Range("9:9"), 0) 
On Error GoTo 0 
If CategoryRow = 0 Or RarityCol = 0 Then Exit Function 



Rarity = ws.Cells(10, RarityCol) 
If Rarity = "Common" Then 
    RarityCol = 1 
ElseIf Rarity = "Rare" Then 
    RarityCol = 2 
ElseIf Rarity = "Epic" Then 
    RarityCol = 3 
Else 
    MsgBox ("Pick a rarity.") 
End If 

TableVal = Worksheets("Talents").Range("B2:D13").Cells(CategoryRow, RarityCol) 
TalentCalc = TalentCalc + TableVal 



End Function