Question

我正在阅读与我所拥有的类似的问题，我的猜测是我有“内存泄漏”。我不确定这意味着什么，或者如何纠正......但是你能看看我的代码并帮我优化吗？ LastRow是~73000

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，但是实际减慢了代码呢？有什么东西我需要改变，或者随着时间的推移正在放慢“发生了什么”？

Answer 1

一些可能会改善效果的建议更改：

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

do循环宏中可能的内存泄漏

1 个答案: