通过autofilter删除需要很长时间

I have roughly 8000+ rows. Using autofilter to delete rows takes a few minutes. I thought autofilter was the defacto FAST way to delete (instead of looping row by row). How can I speed it up? Is there a faster way? To be fair, half of the rows are deleted XD

大概有8000多行。使用autofilter删除行需要几分钟。我认为autofilter实际上是一种快速删除(而不是逐行循环)的方法。我怎样才能加快速度呢?有更快的方法吗?公平地说，有一半的行被删除了XD

With ThisWorkbook.Worksheets("Upload")
    lastRow = .Cells(.Rows.Count, "S").End(xlUp).Row
    Set dataRng = .Range(.Cells(4, 1), .Cells(lastRow, 19))
    dataRng.AutoFilter field:=19, Criteria1:="=0"
    Application.DisplayAlerts = False
    dataRng.Offset(1, 0).Resize(dataRng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    Application.DisplayAlerts = True
    .ShowAllData
End With

2 个解决方案

#1

I'll challange to underlying assumption that AutoFilter is the fast way to go - it is often hard to beat a loop over a variant array

我将对自动过滤器是快速方法这一基本假设提出质疑——在一个变量数组上击败循环通常是困难的

This demo shows a way to do this, on my system processing 8000+ rows removing half runs in sub-second

这个演示展示了一种实现这一点的方法，在我的系统处理8000多行时，在一秒内删除一半的运行

Sub DEMO()
    Dim datrng As Range
    Dim dat, newdat
    Dim i As Long, j As Long, k As Long
    With ThisWorkbook.Worksheets("Upload")
        Set datrng = .Range(.Cells(1, 1), .Cells(.Rows.Count, "S").End(xlUp))
    End With
    dat = datrng.Value
    ReDim newdat(1 To UBound(dat, 1), 1 To UBound(dat, 2))
    j = 1
    For i = 1 To UBound(dat, 1)
        If dat(i, 19) <> 0 Then ' test for items you want to keep
            For k = 1 To UBound(dat, 2)
                newdat(j, k) = dat(i, k)
            Next
            j = j + 1
        End If
    Next

    datrng = newdat
End Sub

#2

I tested the macros for speed and found that sorting, autofiltering and deleting is faster then building an array.

我测试了宏的速度，发现排序、自动过滤和删除比构建数组更快。

Using the timing code here I run the original code over 100k lines of random data (25 columns wide random numbers between 0-4).

使用这里的计时代码，我运行原始代码超过100k行随机数据(0-4之间的25列宽随机数)。

-Original code took 78 seconds (only ran 50k rows here to speed it up)

-原始代码花了78秒(这里只运行了50k行来加速)

-The array code presented by chris took 1.91 seconds

-由chris提出的数组代码用时1.91秒。

-The code below took 0.84 seconds (Tried running it sorting ascending and descending and it made little difference if the range of zeros was sorted to the top or the bottom.

-下面的代码花费了0.84秒(尝试运行它对升序和降序进行排序，如果0的范围被排序到顶部或底部，则没有什么区别。

I realize the built in clock isn't great in vba but the difference is enough that I am comfortable saying sorting,filtering, deleting is at least as fast as arrays in this case.

我意识到在vba中构建的时钟不太好，但是区别就在于我可以轻松地说排序，过滤，删除至少和数组一样快。

The code below just added dataRng.Sort key1:=Range("S4"), order1:=xlDescending, Header:=xlYes to the original code

下面的代码只是添加了dataRng。排序key1:=Range("S4")， order1:= xldescent, Header:=xlYes到原始代码

Sub test()

With Sheets("sheet1")
    lastRow = .Range("S" & .Rows.Count).End(xlUp).Row
    Set dataRng = .Range(.Cells(4, 1), .Cells(lastRow, 25))
    dataRng.Sort key1:=Range("S4"), order1:=xlDescending, Header:=xlYes
    dataRng.AutoFilter field:=19, Criteria1:="=0"
    Application.DisplayAlerts = False
    dataRng.Offset(1, 0).Resize(dataRng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    Application.DisplayAlerts = True
    .ShowAllData
End With
End Sub

#1