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

我有以下代码，我正在使用的解决方法，而不是筛选数据，因为我有多个标准。 我在某处读过，一次只能过滤2个标准吗？
事情是，我有5 – AB, DZ, RE, Z3, ZP – 其他的东西都应该删除。 所以我使用下面的代码，它工作正常，但是每次运行macros时必须处理+30000行，这是非常缓慢的。
无论如何你可以做得更快？ 我正在考虑一次过滤每个标准（创build下面第一个代码中的第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 

Answer 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 

Answer 2

所以我设法做了我以前的代码正在做什么，只是明显更快。 在这个post的帮助下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