Question

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

基本上，我正在读取视频游戏角色中每个天赋的内容，这些内容都在C9：G9中。它会读取每一个以查看它是否与用户选择的类别相匹配，如果匹配，那么它将从C10：G10中获得与人才相关的稀有性。获得该信息后，它使用索引函数从另一张表中读取值，其中包含与人才类别相关的百分比和人才的稀缺程度（例如＆＃34; Common Defense＆＃34;）。行和列索引值的决定是首先搜索按字母顺序排序的人才列表（行值），然后根据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

VBA功能有效但导致Excel崩溃

1 个答案: