Question

我有一个曾经在一分钟内运行的简单宏。但它现在运行得非常慢。运行大约需要一个小时。这是因为我使用的循环吗？有人可以帮我看看出了什么问题吗？

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

宏慢慢跑

1 个答案: