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

试图加快EXCEL VBA中的列表比较

1 个答案: