在 Excel 中（自动）过滤多个条件并删除不匹配行的最快方法？答案

【问题标题】：Fastest way to (auto)filter multiple criterias in Excel and delete non-matching rows?在 Excel 中（自动）过滤多个条件并删除不匹配行的最快方法？
【发布时间】：2015-10-30 14:24:51
【问题描述】：

我使用以下代码作为解决方法，而不是过滤数据，因为我有多个条件。我在某处读到一次只能过滤 2 个条件？
问题是我有 5 个 - AB, DZ, RE, Z3, ZP - 应该删除其他所有内容。所以我使用下面的代码，它工作正常，但每次运行宏都必须处理 +30000 行，它非常慢。
无论如何你可以更快地做到这一点吗？我正在考虑一次过滤每个标准（创建以下第一个代码中的 5 个）。但如果有任何方法可以更快地完成，我将不胜感激。

我使用的代码很慢：

' Step 13 - Filter and Delete All Except
'           AB, DZ, RE, Z3, ZP in Column 6 - Type
Sub FilterDeleteType()
Dim rTable As Range, r As Range
Dim rDelete As Range
Set rDelete = Nothing
Dim v As Variant

Worksheets("Overdue Items").Activate

For Each r In Columns(6).Cells
    v = r.Value
    If v <> "Type" And v <> "AB" And v <> "DZ" And v <> "RE" And v <> "Z3" And v <> "ZP" Then
        If rDelete Is Nothing Then
            Set rDelete = r
        Else
            Set rDelete = Union(r, rDelete)
        End If
    End If
Next

If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

【问题讨论】：

照常做，包括：Application.EnableEvents = False 和 Application.ScreenUpdating = False 和 Application.Calculation = xlCalculationManual 在代码的开头并在最后恢复。
谢谢@Ralph，但是我看不出速度有什么不同:-(
您可能对此答案感兴趣"VBA Performance - Delete one million rows in less than 1 min"

标签： excel for-loop filter autofilter vba

【解决方案1】：

您可以只查看隐藏的行并检查该列 -

Sub test()

Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim lastcol As Integer
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'do your autofilter here

For i = 1 To lastrow
    If Rows(i).Hidden = True Then
        Range(Cells(i, 1), Cells(i, 5)).ClearContents
        Range(Cells(i, 7), Cells(i, lastcol)).ClearContents
        If Cells(i, 6) <> "AB" Or "DZ" Or "RE" Or "Z3" Or "ZP" Then
            Cells(i, 6).ClearContents
        End If
    End If
Next
End Sub

【讨论】：

嗨@raystafarian 我很抱歉我迟到的回复，我一直在度假。但它不起作用。我必须手动过滤才能让它工作，我对此不感兴趣。其次，我在运行它时遇到了运行时错误。
你可以把你的过滤器放在评论“做你的自动过滤器”的地方——这应该可以解决错误，你不需要手动过滤
您好，您的回答有点用处，但我最终选择了另一种方式。我赞成它引导我朝着正确的方向前进 :) 谢谢。

【解决方案2】：

所以我成功地完成了我之前的代码所做的事情，只是速度要快得多。在这篇文章的帮助下https://stackoverflow.com/a/22275522
代码所做的是它filter 我想要的值（使用array），然后它将删除隐藏的行，即未被过滤的行。

Sub FilterType()
Dim LRow As Long
Dim delRange As Range
Dim oRow As Range, rng As Range
Dim myRows As Range

Const Opt1 As String = "AB"
Const Opt2 As String = "DZ"
Const Opt3 As String = "RE"
Const Opt4 As String = "Z3"
Const Opt5 As String = "ZP"

On Error GoTo ErrHandler:
Sheets(1).Activate
With ThisWorkbook.Sheets(1)
    '~~> Remove any filters
    .AutoFilterMode = False

    LRow = .Range("F" & .Rows.Count).End(xlUp).Row

    With .Range("F1:F" & LRow)
        .AutoFilter Field:=1, Criteria1:=Array(Opt1, Opt2, Opt3, Opt4, Opt5), Operator:=xlFilterValues
    End With

    With Sheets(1)
        Set myRows = Intersect(.Range("F:F").EntireRow, .UsedRange)
        If myRows Is Nothing Then Exit Sub
    End With

    For Each oRow In myRows.Columns(6).Cells
    If oRow.EntireRow.Hidden Then
        If rng Is Nothing Then
            Set rng = oRow
        Else
            Set rng = Union(rng, oRow)
        End If
    End If
    Next

ErrHandler:
    '~~> Remove any filters
    .AutoFilterMode = False
End With
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

【讨论】：