Нужна помощь, чтобы сократить время выполнения кода ниже

Question

Ниже код сравнивает 1500 строк с примерно 14 столбцами.Их выполнение занимает около 30 минут.Есть ли способ, я мог бы уменьшить код, изменив код ниже. Я хотел бы получить все ваши мнения экспертов.Код выполняет следующую функцию:
Выполнить все записи на старом листе.
, если он найден на НОВОМ листе, ничего не делать
, если не найден на НОВОМ листе, удалить его со СТАРОГО листа

Option Explicit

Function UpdateOLD() As Long
'     This Sub will do the Following Update
'     Run through all records in OLD
'        if found in NEW  ---> Do nothing
'        if not found in NEW ----> Delete it from OLD.
'
Dim WSO As Worksheet
Dim WSN As Worksheet
Dim MaxRowO As Long, MaxRowN As Long, I As Long, J As Long, lDel As Long
Dim sJob As String, sOps As String, sFirstAddress As String
Dim cCell As Range
Dim bNotFound As Boolean


'---> Disable Events
With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'---> Set Variables
Set WSO = Sheets("Steps")
Set WSN = Sheets("Interface")
MaxRowO = WSO.Range("A" & WSO.Rows.Count).End(xlUp).Row
MaxRowN = WSN.Range("C" & WSN.Rows.Count).End(xlUp).Row
WSO.Range("N2:N" & MaxRowO).ClearContents

'---> Loop thruough all rows in sheet New
For I = MaxRowO To 2 Step -1
    bNotFound = False
    sJob = WSO.Cells(I, "B")
    sOps = WSO.Cells(I, "C")
    Set cCell = WSN.Range("D6:D" & MaxRowN).Find(what:=sJob, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        bNotFound = True
        sFirstAddress = cCell.Address
        Do
            '---> Check to See if Ops if found for that Job
            If WSN.Cells(cCell.Row, "E") = sOps Then
                bNotFound = False
                Exit Do
            End If
            Set cCell = WSN.Range("D6:D" & MaxRowN).FindNext(cCell)
        Loop While Not cCell Is Nothing And cCell.Address <> sFirstAddress
    Else
        bNotFound = True
    End If

    '---> Del Record from OLD if Not Found
    If bNotFound Then
        WSO.Range(I & ":" & I).EntireRow.Delete
        'WSO.Range("N" & I) = sJob & " " & sOps & " Deleted as NOT found in NEW"
        lDel = lDel + 1
    End If


Next I

'---> Enable Events
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

UpdateOLD = lDel

End Function

Answer 1

Добро пожаловать в SO.Пробовал ваш код с примерно 2000 строками с несоответствием примерно на 10%, и это займет всего несколько секунд. может быть файл имеет некоторые другие проблемы. Однако один из способов ускорить (примерно вдвое меньше времени, затраченного на мои испытания) - это добавить все ячейки bNotFound в объединение диапазона и удалить EntireRow диапазона за один выстрел после завершения цикла.

Изменения в коде:

Dim Rng As Range    'Add in  Declare section 
'
'
'
'
For I = 2 To MaxRowO   'No need to loop backward
'
'
'
'
    If bNotFound Then                       ' Only add to Union of ranges
        If Rng Is Nothing Then
        Set Rng = WSO.Range("A" & I)
        Else
        Set Rng = Union(Rng, WSO.Range("A" & I))
        lDel = lDel + 1
        End If
    End If
Next I

If Not Rng Is Nothing Then Rng.EntireRow.Delete       ' delete in one shot