最简单的方式来删除不能用SpecialCells抓住的行 [英] Fastest way to delete rows which cannot be grabbed with SpecialCells

问题描述

根据关于另一个问题这个网站我开始想知道如何以一定条件删除所有行的最快方法。

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

（1）循环遍历工作表上的所有行（向后），并逐个删除符合条件的所有行。

2）首先将适用的范围移动到一个数组中，然后评估数组中的条件，并根据这些 - 在底层工作表上逐个删除所有行。

可能的改进可能是删除块中的所有行以减少访问工作表的开销。但是，如果你去这条路线，那么你有各种各样的选择可以在实际删除范围之前存储范围：

（1）使用 / code>合并要删除的范围。

（2）只需写一个 String 所有行都要删除。

那么这是最快的方法吗？

解决方案

一个有效的解决方案是标记所有的行，以保持并移动所有行，以便通过排序标签来最后删除。
这样，复杂性不会随着要删除的行数而增加。

此示例在不到一秒内删除50000行，全部列 I 的行等于 2 ：

<$数据（），标签（），计数& r&

'加载数组
设置rgTable = ActiveSheet.UsedRange
data = rgTable.Value

'标记要保留的所有行行号。否则为空。
ReDim标签（1到UBound（数据），1到1）
标签（1，1）= 1'保持标题
对于r = 2到UBound（数据）
如果数据（r，9） 2然后如果列I'，则标签（r，1）= r' 2保持行
下一个

'在右侧的最后一列中插入标签
设置rgTags = rgTable.Columns（rgTable.Columns.count + 1）
rgTags.Value = tags

'将标记上的行排序，这些行会将行移动到结尾处删除
Union（rgTable，rgTags）.Sort key1：= rgTags，Orientation： = xlTopToBottom，标题：= xlYes
count = rgTags.End（xlDown）.Row

'删除右侧的标签和没有标记的行
rgTags。 EntireColumn.Delete
rgTable.Resize（UBound（data） - count + 1）.Offset（count）.EntireRow.Delete
End Sub

请注意，它不会改变行的顺序。

Based on another question on this site I started wondering about the fastest way to delete all rows with a certain condition.

The above referenced question came with various solutions:

(1) Loop through all rows on the sheet (backwards) and delete all rows one-by-one which meet the condition.

(2) Move the applicable range into an array first and then evaluate the conditions in the array and - based on that - delete all rows one-by-one on the underlying sheet.

A possible improvement might be to delete all rows in chunks to reduce the overhead of accessing to the worksheet. But if you go this route then you have various options to "store" the ranges before you actually delete them:

(1) Use Intersect to merge the ranges which should be deleted.

(2) Simply write a String with all the rows to be deleted.

So, which is the fastest way to do that?

解决方案

One efficient solution is to tag all the rows to keep and move all the rows to delete at the end by sorting the tags. This way, the complexity doesn't increase with the number of rows to delete.

This example deletes in less than a second, for 50000 rows, all the rows where column I is equal to 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

Note that it doesn't alter the order of the rows.

这篇关于最简单的方式来删除不能用SpecialCells抓住的行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！