删除无法使用SpecialCells抓取的行的最快方法

Question

基于该网站上的另一个问题,我开始想知道删除具有特定条件的所有行的最快方法.

上面提到的问题有各种解决方案:

(1)遍历工作表上的所有行(向后)并逐个删除满足条件的所有行.

(2)首先将适用范围移动到数组中,然后评估数组中的条件,并在此基础上逐个删除基础工作表上的所有行.

可能的改进可能是删除块中的所有行以减少访问工作表的开销.但是如果你走这条路线那么你有多种选择来"存储"范围,然后才真正删除它们:

(1)Intersect用于合并应删除的范围.

(2)只需编写一个String包含要删除的所有行.

那么,这是最快的方法呢？

Answer 1

一个有效的解决方案是标记所有行以保留并通过对标记进行排序将所有行移动到最后删除.这样,复杂性不会随着要删除的行数而增加.

对于50000行,此示例在不到一秒的时间内删除列I等于的所有行2:

Sub DeleteMatchingRows()
    Dim rgTable As Range, rgTags As Range, data(), tags(), count&, r&

    ' load the data in an array
    Set rgTable = ActiveSheet.UsedRange
    data = rgTable.Value

    ' tag all the rows to keep with the row number. Leave empty otherwise.
    ReDim tags(1 To UBound(data), 1 To 1)
    tags(1, 1) = 1  ' keep the header
    For r = 2 To UBound(data)
      If data(r, 9) <> 2 Then tags(r, 1) = r  ' if column I <> 2 keep the row
    Next

    ' insert the tags in the last column on the right
    Set rgTags = rgTable.Columns(rgTable.Columns.count + 1)
    rgTags.Value = tags

    ' sort the rows on the tags which will move the rows to delete at the end
    Union(rgTable, rgTags).Sort key1:=rgTags, Orientation:=xlTopToBottom, Header:=xlYes
    count = rgTags.End(xlDown).Row

    ' delete the tags on the right and the rows that weren't tagged
    rgTags.EntireColumn.Delete
    rgTable.Resize(UBound(data) - count + 1).Offset(count).EntireRow.Delete
End Sub

请注意,它不会改变行的顺序.