VBA機能は動作しますが、Excelがクラッシュする

Question

最後にVBAを使用してからトレーニングがかなり基本的だったので2年経ったので、私はコーディングの練習にExcelシートを使っています。あなたが私のコードを見て、何が起こっているのかという考えを気にしないなら、私はそれを高く評価します。コードの反復性については申し訳ありません。以下はコードの機能とコードそのものの説明です。

基本的に、私は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