Question

我使用以下代码作为解决方法而不是过滤数据，因为我有多个标准。我在某处读过，一次只能过滤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

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

所以我设法完成了我以前的代码所做的工作，速度明显提高了。在这篇文章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

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

2 个答案: