通过自动过滤器删除时间过长 [英] Deleting via autofilter takes too long

问题描述

我有大约8000多行。使用autofilter删除行需要几分钟。我认为autofilter是defacto FAST删除方式（而不是逐行循环）。我如何加快速度？有更快的方法吗？公平地说，一半的行被删除XD

 使用ThisWorkbook.Worksheets（Upload）
 lastRow = .Cells（.Rows.Count，S）。End（xlUp）.Row 
设置dataRng = .Range（.Cells（4，1），.Cells（lastRow，19））
 dataRng .AutoFilter字段：= 19，Criteria1：== 0
 Application.DisplayAlerts = False 
 dataRng.Offset（1，0）.Resize（dataRng.Rows.Count  -  1）.SpecialCells（xlCellTypeVisible ）.Rows.Delete 
 Application.DisplayAlerts = True 
 .ShowAllData 
结束
  

解决方案

我将挑战AutoFilter的基本假设，即AutoFilter是快速的方式 - 通常难以通过变体数组击败循环

此演示文稿显示了一种方法，在我的系统上处理8000+行删除半秒钟的次数

  Sub DEMO（）
 Dim datrng As Range 
 Dim dat，newdat 
 Dim i As Long，j As Long，k As Long 
 With ThisWorkbook .Worksheets（Upload）
设置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）
如果dat（i，19）<> 0然后'测试你想保留的项目
对于k = 1到UBound（dat，2）
 newdat（j，k）= dat（i，k）
下一个
j = j + 1 
 End If 
 Next 
 
 datrng = newdat 
 End Sub 
  

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

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

解决方案

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

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

这篇关于通过自动过滤器删除时间过长的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！