VBA-Funktion funktioniert, aber verursacht Excel zum Absturz

Question

Ich mache ein Excel-Blatt für ein Spiel, um meine Codierung zu üben, weil es zwei Jahre her ist, seit ich zuletzt VBA verwendet und mein Training war ziemlich einfach. Wenn es Ihnen nichts ausmacht, meinen Code anzuschauen und mir eine Idee davon zu geben, was passieren könnte, würde ich das sehr schätzen. Entschuldigung wegen der Wiederholbarkeit des Codes. Im Folgenden finden Sie eine Beschreibung der Code-Funktion und des Codes selbst.

Grundsätzlich habe ich es den Inhalt jedes Talents auf dem Videospiel-Charakter lesen, die in C9: G9 sind. Es liest jedes einzelne, um zu sehen, ob es mit der vom Benutzer ausgewählten Kategorie übereinstimmt, und wenn dies der Fall ist, wird es die Rarität erhalten, die mit dem Talent aus C10: G10 verbunden ist. Nachdem diese Information verwendet wurde, verwendet sie die Indexfunktion, um Werte von einem anderen Blatt zu lesen, das die Prozentsätze enthält, die den Talentkategorien und der Seltenheit des Talents zugeordnet sind (z. B. "Gemeinsame Verteidigung"). Die Zeilen- und Spaltenindexwerte werden bestimmt, indem zuerst eine alphabetisch sortierte Liste von Talenten (Zeilenwert) durchsucht wird und zweitens ein Spaltenwert durch die von C10: G10 angegebene Seltenheit zugewiesen wird.

Der Code scheint so ausgeführt zu werden, wie ich es vorhabe, aber jedes Mal, wenn ich versuche, diese Funktion ein paar Excel-Zeilen nach unten zu ziehen, wird das Programm eingefroren und stürzt ab.

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

Code vereinfacht:

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