Makro läuft langsam

Question

Ich hatte ein einfaches Makro, das in einer Minute ausgeführt wurde. Aber es läuft jetzt sehr langsam. Es dauert ungefähr eine Stunde zu laufen. Ist das wegen der Schleife, die ich verwende? Kann mir jemand helfen zu sehen, was schief gelaufen ist?

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

Verwenden Sie eine Statusleiste, um festzustellen, wo der Code verlangsamt wird. Here's one site with simple code (unten enthalten, falls die Verbindung fehlschlägt), aber es gibt viele andere. Für Code, der jetzt im Vergleich zu früher 60-mal langsamer läuft, könnte etwas auf den Computer hindeuten. Hast du neu gestartet? Können Sie zu einem früheren Sicherungsstatus zurückkehren?

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