マクロがゆっくりと実行されています

Question

1分で実行していたシンプルなマクロがありました。しかし、今は非常にゆっくり走っています。走るのに約1時間かかります。これは私が使っているループのためですか？誰かが私が何がうまくいかなかったかを助けることができます

Sub Runtable() 

Sheets("RateTable").Cells(1, "A") = "ID" 
Sheets("RateTable").Cells(1, "B") = "Section" 
Sheets("RateTable").Cells(1, "C") = "Gender" 
Sheets("RateTable").Cells(1, "D") = "Age" 
     ' 
LastID = Sheets("Input").Cells(2, 22) 
For ID = 0 To LastID 

LastSet = Sheets("Input").Cells(2, 19) 
For myRow = 2 To LastSet 
Sheets("RateTable").Cells(ID * (LastSet - 1) + myRow, 1) = Sheets("Input").Cells(ID + 2, 1) 
Next myRow 
Next ID 
    ' 
Dim myMyRow As Long 
Dim OutputMyRow As Long 
OutputMyRow = 2 

LastID = Sheets("Input").Cells(2, 22) 
LastSection = Sheets("Input").Cells(2, 21) 
LastAge = Sheets("Input").Cells(2, 20) 
For ID = 0 To LastID 
For Section = 0 To LastSection 
For myMyRow = 2 To LastAge 
Sheets("RateTable").Cells(OutputMyRow, 2).Value = Sheets("Input").Cells(Section - FirstID + 2, "N").Value 

OutputMyRow = OutputMyRow + 1 

Next myMyRow 
Next Section 
Next ID 

    ' 
EndGenderLoop = Sheets("Input").Cells(2, 23) 
For myRow = 2 To EndGenderLoop 
Sheets("RateTable").Cells(myRow, 3) = Sheets("Input").Cells(2, 17) 
Next myRow 
    ' 
EndAgeLoop = Sheets("Input").Cells(2, 24) 
For AgeCurve = 0 To EndAgeLoop 
    ' 
For myRow = 2 To 52 
Sheets("RateTable").Cells(AgeCurve * 51 + myRow, 4) = Sheets("Input").Cells(myRow, 10) 
Next myRow 
Next AgeCurve 
' 
End Sub 

Answer 1

コードが減速している場所を特定するには、ステータスバーを使用します。 Here's one site with simple code（リンクが失敗した場合には以下に含まれます）が他にもたくさんあります。コードでは、この単純な60倍の速度で実行されているため、以前のものと比較して、コンピュータに何か問題がある可能性があります。あなたは再開しましたか？以前のバックアップ状態に戻すことはできますか？

Option Explicit 

Sub StatusBar() 

    Dim x    As Integer 
    Dim MyTimer   As Double 

    'Change this loop as needed. 
    For x = 1 To 250 

     'Dummy Loop here just to waste time. 
     'Replace this loop with your actual code. 
     MyTimer = Timer 
     Do 
     Loop While Timer - MyTimer < 0.03 

     Application.StatusBar = "Progress: " & x & " of 250: " & Format(x/250, "Percent") 
     DoEvents 

    Next x 

    Application.StatusBar = False 

End Sub