Excel·VBA时间范围筛选及批量删除整行_vba如何按照时间范围筛选

link管理
链接快照平台
输入网页链接，自动生成快照
标签化管理网页链接
批量删除整行，整体删除

采用《Excel·VBA指定条件删除整行整列》先 Union 行再删除的方法可大幅提高速度
Sub 时间范围筛选()
    Dim dict As Object, rng As Range, arr, i&, k$
    Set dict = CreateObject("scripting.dictionary"): tm = Timer
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    arr = Worksheets("条件").[a1].CurrentRegion
    For i = 2 To UBound(arr)
        k = arr(i, 1) & "_" & arr(i, 2)
        dict(k) = Array(CDbl(arr(i, 3)), CDbl(arr(i, 4)))
    Worksheets("数据").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "筛选结果": arr = .[a1].CurrentRegion: ReDim brr(1 To UBound(arr))
        For i = 2 To UBound(arr)
            k = arr(i, 1) & "_" & arr(i, 2)
            If Not dict.Exists(k) Then  '不存在的直接删除
                If rng Is Nothing Then
                    Set rng = .Rows(i)
                    Set rng = Union(rng, .Rows(i))
                End If
                '符合条件时间范围
                If Not (dict(k)(0) <= CDbl(arr(i, 3)) And CDbl(arr(i, 4)) <= dict(k)(1)) Then
                    If rng Is Nothing Then
                        Set rng = .Rows(i)
                        Set rng = Union(rng, .Rows(i))
                    End If
                End If
            End If
        If Not rng Is Nothing Then rng.Delete
    End With
    Application.ScreenUpdating = True
    Debug.Print "筛选完成，用时" & Format(Timer - tm, "0.00")  '耗时
End Sub
筛选结果：运行几个小时也未能生成结果
 这显然不合理，就算是50万行的数据，使用字典也不可能耗时如此之久
 将Union行的操作全部注释改为计数后可以发现，遍历50万行并判断是否符合条件时间范围，仅用时2.25秒，而之前的经验都是“先Union行再删除的方法”比“倒序循环依次删除整行的方法”速度更快，但本例中Union行的操作却很慢，那么就是行数太多导致反复Union行消耗太多时间 
批量删除整行，分段删除
 
既然上面的代码运行缓慢可能是“反复Union行消耗太多时间”，那么就应该试试看倒序分段删除 
Sub 时间范围筛选2()
    Dim dict As Object, rng As Range, arr, brr, i&, j&, k$, x&
    Set dict = CreateObject("scripting.dictionary"): tm = Timer
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    arr = Worksheets("条件").[a1].CurrentRegion
    For i = 2 To UBound(arr)
        k = arr(i, 1) & "_" & arr(i, 2)
        dict(k) = Array(CDbl(arr(i, 3)), CDbl(arr(i, 4)))
    Worksheets("数据").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "筛选结果": arr = .[a1].CurrentRegion: ReDim brr(1 To UBound(arr))
        For i = 2 To UBound(arr)
            k = arr(i, 1) & "_" & arr(i, 2)
            If Not dict.Exists(k) Then  '不存在的直接删除
                j = j + 1: brr(j) = i
                '符合条件时间范围
                If Not (dict(k)(0) <= CDbl(arr(i, 3)) And CDbl(arr(i, 4)) <= dict(k)(1)) Then
                    j = j + 1: brr(j) = i
                End If
            End If
        For i = j To 1 Step -1  '倒序分段删除
            x = x + 1
            If rng Is Nothing Then
                Set rng = .Rows(brr(i))
                Set rng = Union(rng, .Rows(brr(i)))
            End If
            If x = 1000 Then rng.Delete: Set rng = Nothing: x = 0
        If Not rng Is Nothing Then rng.Delete
    End With
    Application.ScreenUpdating = True
    Debug.Print "筛选完成，用时" & Format(Timer - tm, "0.00")  '耗时
End Sub
筛选结果：成功生成符合条件时间范围的筛选结果，共保留57668行数据
  
不同分段行数速度对比
 
分段行数 100 500 1000 5000 10000
耗时秒数 697.84 643 629.43 687 888.17
可以发现，分段在1万行以内时，运行速度差异还不明显，而总共需要删除的行数为442332行，因此以上“行数太多导致反复Union行消耗太多时间”的猜测是对的 
而如果将筛选条件改为，时间范围完全不重叠 
'条件开始时间 > 筛选结束时间，或条件结束时间 < 筛选开始时间
If dict(k)(0) > CDbl(arr(i, 4)) Or dict(k)(1) < CDbl(arr(i, 3)) Then
总共需要删除的行数为242931行时，可能是需要删除的行与行之间分散的更稀碎，导致比上面的删除442332行耗时差异更加明显，测试如下图 
分段行数 100 500 1000 5000 10000
耗时秒数 1233.98 1234.9 1268.61 1939.34 4079.09
需要删除的行数变少，但在同样的分段下不仅消耗时间更多，而且分段为1万行时消耗时间增长率也更高，那么可以得出结论，不仅反复Union行消耗太多时间，而且行与行之间太分散也会消耗更多时间
				大家好，我是陈小虾，是一名自动化方向的IT民工。写博客是为了记录自己的学习过程，通过不断输出倒逼自己加速成长。但功能说明：由于水平有限，博客中难免会出现一些BUG，或者有更优方案恳请各位大佬不吝赐教！微信公众号：万能的Excel
上一篇我们已经用VBA实现SQL检索，并实现相同项求和的功能。那么如何根据日期范围筛选我们需要的数据呢？今天我们看看另外一个SQL查询结构：
SQL = "select 字段1 from [原始数据$] where 出库时间 between #开始时间# And ...
特定场景：
工作中经常遇到一些软件导出的表格，其中的各级小计分布在不同的列，“小计”二字之间有的还加入了数量不等的空格，实际统计时这些小计行在其中非常碍事，于是得想个办法快速删掉它。
提示：删除内容有风险，请谨慎测试
如果用循环逐单元格取值判断是否包含某字符，速度会非常慢，只有在没有其他办法可想的时候才用这种办法。
快速定位的方法很多，但最快的应该还是Excel自带的方法：
Range.SpecialCell.