我有一个代码,用于比较同一工作表中的两个列表,并从两个列表中的一个列表中删除整行,但现在运行速度非常慢(随着数据的增长),我正在尝试加快这个过程。
我在很大程度上没有成功地做到这一点,而且我正在寻求一些帮助,
谢谢!
代码:
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
答案 0 :(得分: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