试图加快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