（Excel 2003 VBA）根据列中的多个条件删除整行

我有一个有趣的问题。我试着搜索这个网站和谷歌，但只有轻微的相关问题，没有一个真正解决这个具体需求

我有一个有10列的电子表格（我们称它们为

a-J

）。我需要删除H列单元格中所有值不为

“30”、“60”、“90”、“120”或空白的行

虽然有很多方法可以做到这一点，但所有方法都依赖于循环，这对我来说不起作用，因为这个数据集有超过25k行，运行需要10多分钟——太长了

我一直在研究与
.Find
功能结合使用的自动筛选选项（例如，查找不符合条件的H单元格的所有行并删除），但2003年的
自动筛选
仅适用于2个条件，而我有5个条件要检查。我不知道如何进行

非常感谢您的帮助。
您可以尝试高级筛选选项，您可以提供两个以上的条件来筛选列表。过滤与您设置的条件匹配的列表后，可以将过滤后的列表复制到另一个位置（可用选项），并删除剩余的列表。
这将在20秒内删除25k行样本中的所有匹配行（~10%）

Sub tt()

Dim rw As Range
Dim all As Range
Dim t
Dim b As Boolean

t = Timer
For Each rw In Range("A1").CurrentRegion.Rows

    If rw.Cells(8).Value < 1 Then

        If b Then
            Set all = Application.Union(rw, all)
        Else
            Set all = rw
            b = True
        End If

    End If

Next rw

If not all is nothing then all.EntireRow.Delete

Debug.Print "elapsed: " & Timer - t

End Sub

Sub tt（）
变暗rw As范围
调暗所有As范围
暗t
作为布尔值的dimb
t=计时器
对于范围（“A1”）.CurrentRegion.Rows中的每个rw
如果rw.单元格（8）.值<1，则
如果b那么
Set all=Application.Union（rw，all）
其他的
设置全部=rw
b=正确
如果结束
如果结束
下一个rw
如果并非全部为空，则all.EntireRow.Delete
调试。打印“已用：”&计时器-t
端接头
您可以根据自己的条件添加一列：

=IF(OR(H1=30;H1=60;H1=90;H1=120;H1="");"DELETE";"")

（公式是针对第1行给出的，您必须将其复制粘贴到整个范围）

然后使用筛选和排序选择要删除的行。
一些速度提示：

当使用大数据时，为数组赋值，使用数组代替*.Value
当使用完整列时，忽略底部的空列
在工作表中进行密集更改时，禁用屏幕更新和自动计算
说明这一点，我将使用以下代码：

Sub Macro1()
    Dim su As Boolean, cm As XlCalculation
    Dim r As Long, v(), r_offset As Long

    su = Application.ScreenUpdating
    Application.ScreenUpdating = False 'Disable screen updating
    cm = Application.Calculation
    Application.Calculation = xlCalculationManual 'Disable automatic calculation

    'Only use used values
    With Intersect(Range("H:H"), Range("H:H").Worksheet.UsedRange)
        v = .Value 'Assign values to array
        r_offset = .Row - LBound(v) 'Mapping between array first index and worksheet row number
    End With

    'Check all row from bottom (so don't need to deal with row number changes after deletion)
    For r = UBound(v) To LBound(v) Step -1
        Select Case v(r, 1)
        Case "30", "60", "90", "120", Empty 'Do nothing
        Case Else
            Sheet1.Rows(r + r_offset).EntireRow.Delete
        End Select
    Next
    Application.ScreenUpdating = su 'Restore screen updating
    Application.Calculation = cm 'Restore calculation mode
End Sub

感谢所有提出解决方案的人。在这段时间里，我终于想出了一种方法，如果您首先将整个数据集读取到一个二维数组中，然后将“好”行复制到第二个相同大小的数组中，那么您可以使用循环快速地处理它。然后将“good”数组转储回工作表。除非您有需要保留的单元格格式。也许显示你已经拥有的代码太慢了？