VBA功能有效但导致Excel崩溃

I am doing an excel sheet for a game to practice my coding because it has been two years since I last used VBA and my training was quite basic. If you don't mind looking at my code and giving me an idea of what might be going, I would greatly appreciate it. Sorry about the repetitiveness of the code. Below is a description of the code's function and the code itself.

我正在做一个excel表格来练习我的编码，因为我上次使用VBA已经两年了，我的训练非常基础。如果您不介意查看我的代码并让我知道可能会发生什么，我将非常感激。对于代码的重复性感到抱歉。下面是代码功能和代码本身的描述。

Basically, I am having it read the contents of each talent on the video game character, which are in C9:G9. It reads each one to see if it matches the category selected by the user, and if it does, then it will acquire the rarity associated with the talent from C10:G10. After having that info, it uses the index function to read values from another sheet containing the percentages associated with the talent categories and rarity of the talent (say "Common Defense"). The row and column index values are decided by first searching through a list of talents sorted alphabetically (row value) and secondly assigning a column value by the rarity indicated from C10:G10.

基本上，我正在阅读电子游戏角色中每个天赋的内容，这些内容都在C9：G9中。它读取每一个以查看它是否与用户选择的类别匹配，如果匹配，那么它将从C10：G10中获得与人才相关的稀有性。获得该信息后，它使用索引函数从另一张表中读取值，其中包含与人才类别相关的百分比和人才的稀有度（比如“Common Defense”）。通过首先搜索按字母顺序排序的人才列表（行值）来确定行和列索引值，然后通过从C10：G10指示的稀有度来指定列值。

The code seems to be executing the way I intended, but whenever I try to drag this function down a few rows of excel, it causes the program to freeze and crash.

代码似乎按照我的意图执行，但每当我尝试将此函数拖动到几行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

1 个解决方案

#1

your code simplified:

你的代码简化了：

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