Пытается ускорить сравнение списка в EXCEL VBA

Question

У меня есть код, который сравнивает два списка на одном листе и удаляет всю строку из одного из двух списков, однако в настоящее время он работает очень медленно (по мере роста данных) и Я пытаюсь ускорить процесс.

Я не преуспевая в этом какой-либо значительной степени, и я ищу некоторую помощь,

Спасибо!

Код:

Sub Clean_Up_Lists() 
'run comparisons... clean up lists' 

'turn of screen updating to speed up macro' 
Application.ScreenUpdating = False 

Dim iListCount As Long 
Dim x As Range 
Dim iCtr As Long 


'get count of records to search through(list that will be deleted)' 
iListCount = Sheets("Allocations").Cells(Rows.Count, "B").End(xlUp).Row 


For Each x In Sheets("Allocations").Range("N200:N400" & Sheets("Allocations").Cells(Rows.Count, "B").End(xlUp).Row) 



'loop through all records in the second list' 
For iCtr = iListCount To 1 Step -1 

If x.Value = Sheets("Allocations").Cells(iCtr, 2).Value Then 
Sheets("Allocations").Cells(iCtr, 2).EntireRow.ClearContents 
'if match exists --> clear contents from allocations list' 

End If 
Next iCtr 
Next 

Application.ScreenUpdating = True 

End Sub 

Answer 1

Попробуйте это:

Sub Clean_Up_Lists() 
    Application.ScreenUpdating = False 

    Dim i As Long 
    Dim rng As Range, c As Range 
    Dim rngToClear As Range 
    Dim arr 

    With Sheets("Allocations") 
     Set rng = .Range("N200:N400") 
     arr = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value 
     For i = 1 To UBound(arr, 1) 
      If Not IsError(Application.Match(arr(i, 1), rng, 0)) Then 
       If rngToClear Is Nothing Then 
        Set rngToClear = .Range("B" & i) 
       Else 
        Set rngToClear = Union(rngToClear, .Range("B" & i)) 
       End If 
      End If 
     Next i 
    End With 

    If Not rngToClear Is Nothing Then rngToClear.EntireRow.ClearContents 

    Application.ScreenUpdating = True 
End Sub