VBA功能有效，但会导致Excel崩溃

Question

我正在为游戏编写一张Excel表格来练习我的编码，因为自从上次使用VBA至今已经两年了，而且我的培训非常基础。 如果你不介意看我的代码，并给了我可能什么的想法，我将不胜感激。 对不起代码的重复性。 下面是代码的函数的说明和代码本身。

基本上，我有它读取每个天赋上的视频游戏角色的内容，这是在C9：G9。 它读取每个人是否与用户选择的类别相匹配，如果匹配，则它将从C10：G10获得与人才相关的稀有性。 获得该信息后，它将使用索引函数从另一个工作表中读取值，该工作表包含与人才类别和人才稀有度相关的百分比（例如“共同防御”）。 通过首先搜索按字母顺序排序的人才列表（行值），然后通过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