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