do循环macros中可能的内存泄漏
我正在阅读有关类似的问题，我的猜测是我有一个“内存泄漏”。 我不确定这意味着什么，或者如何纠正。但是你能看看我的代码，并帮助我优化吗？ LastRow是LastRow
start = Timer Do Until Row > LastRow DoEvents If Original.Cells(Row, 4) <> "" Then Application.StatusBar = "Progress: " & Row & " out of " & LastRow & ": " & Format(Row / LastRow, "0.00%") 'VLookUp method ''''' Data.Cells(DataRow, 1) = Original.Cells(Row, 4) ''''' Data.Cells(DataRow, 2) = Original.Cells(Row, 39) ''''' Result = Evaluate("Vlookup('New Cost Data'!A" & DataRow & ",'PupFile Data'!B:D,3,false)") ''''' ''''' If IsError(Result) = True Then ''''' Data.Cells(DataRow, 3) = "No Old Cost" ''''' DataRow = DataRow + 1 ''''' ElseIf Result = 0 Then ''''' Data.Cells(DataRow, 3) = "No Old Cost" ''''' DataRow = DataRow + 1 ''''' Else ''''' Data.Cells(DataRow, 3) = Result ''''' Data.Cells(DataRow, 4) = Format((Data.Cells(DataRow, 2) - Result) / Result, "0.00%") ''''' DataRow = DataRow + 1 ''''' End If 'Find() method Set RNGFound = Range(Pup.Cells(2, 2), Pup.Cells(Pup.Cells(Rows.count, 2).End(xlUp).Row, 2)).Find(Original.Cells(Row, 4)) If Not RNGFound Is Nothing Then PupRow = Range(Pup.Cells(2, 2), Pup.Cells(Pup.Cells(Rows.count, 2).End(xlUp).Row, 2)).Find(Original.Cells(Row, 4), lookat:=xlWhole, searchorder:=xlRows, MatchCase:=True).Row Data.Cells(DataRow, 1) = Original.Cells(Row, 4) Data.Cells(DataRow, 2) = Original.Cells(Row, 39) Data.Cells(DataRow, 3) = Pup.Cells(PupRow, 4) Data.Cells(DataRow, 4) = (Data.Cells(DataRow, 2) - Data.Cells(DataRow, 3)) / Data.Cells(DataRow, 3) Else Data.Cells(DataRow, 1) = Original.Cells(Row, 4) Data.Cells(DataRow, 2) = Original.Cells(Row, 39) Data.Cells(DataRow, 3) = "No old Cost" End If DataRow = DataRow + 1 End If Row = Row + 1 Loop Application.StatusBar = False finish = Timer - start MsgBox finish Stop
Vlookup方法花了我大约500秒，但从一开始就大大减缓。 find（）方法看起来好像需要更长的时间，所以我可能会用vlookup，但是实际的代码放慢呢？ 是否有什么我需要改变，或者随着时间的推移正在减速只是“发生了什么”？
一些build议的应该改进性能的改变：
Dim tmp, rngFind As Range Set rngFind = Pup.Range(Pup.Cells(2, 2), _ Pup.Cells(Pup.Cells(Rows.Count, 2).End(xlUp).Row, 2)) With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Start = Timer Do Until Row > LastRow tmp = Original.Cells(Row, 4) If Len(tmp) > 0 Then If Row Mod 100 = 0 Then 'don't update status *every* row - will slow you down Application.StatusBar = "Progress: " & Row & " out of " & _ LastRow & ": " & Format(Row / LastRow, "0.00%") DoEvents 'do this less frequently also... End If Set RNGFound = rngFind.Find(Original.Cells(Row, 4)) With Data.Rows(Datarow) .Cells(1).Value = tmp .Cells(2).Value = Original.Cells(Row, 39) If Not RNGFound Is Nothing Then .Cells(3).Value = Pup.Cells(RNGFound.Row, 4) .Cells(4).Value = (.Cells(2) - .Cells(3)) / .Cells(3) Else .Cells(3) = "No old Cost" End If End With Datarow = Datarow + 1 End If Row = Row + 1 Loop With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Application.StatusBar = False finish = Timer - Start MsgBox finish