VBA 如果条件存在则自动过滤

Question

我已经记录了宏来自动过滤和删除表中的行。 但这不是动态的，因为如果给定表中不存在过滤条件，则宏将中断。

我正在尝试创建一个代码，如果条件存在或不执行任何操作，该代码将自动过滤并删除行。 我正在尝试关注这篇文章，但我遗漏了一些东西。 请帮忙。

我的代码没有返回任何错误，但也没有执行任何操作。 我添加了消息框以确保它确实在运行。

到目前为止，这是我的代码：

Sub autofilter()

Dim lo As ListObject

    Set lo = Worksheets("BPL").ListObjects("Table1")
   
    
With Sheets(1)
    If .AutoFilterMode = True And .FilterMode = True Then
        If lo.Parent.autofilter.Filters(7).Criteria1 = "APGFORK" Then
            '
    lo.Range.autofilter Field:=7, Criteria1:="APGFORK"
    
    Application.DisplayAlerts = False
       lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.autofilter.ShowAllData
            '
        End If
    End If
End With

MsgBox ("Code Complete")

End Sub

Answer 1

删除 Excel 表中的过滤行

• 不是整行！

Option Explicit

Sub DeleteFilteredRows()
   
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim tbl As ListObject: Set tbl = wb.Worksheets("BPL").ListObjects("Table1")
   
    Dim dvrg As Range ' Data Visible Range
   
    With tbl
        If .ShowAutoFilter Then
            If .Autofilter.FilterMode Then .Autofilter.ShowAllData
        End If 
        .Range.Autofilter 7, "APGFORK"
        On Error Resume Next
            Set dvrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        .Autofilter.ShowAllData
    End With
    
    Dim IsSuccess As Boolean

    If Not dvrg Is Nothing Then
        dvrg.Delete xlShiftUp
        IsSuccess = True
    End If
    
    If IsSuccess Then
        MsgBox "Data deleted.", vbInformation
    Else
        MsgBox "Nothing deleted.", vbExclamation
    End If

End Sub

Answer 2

我不知道它是错误还是功能，但是。AutoFilterMode 似乎在 Excel 2013 或之后一直返回 False。 我看到的所有使用 use.AutoFilterMode 的例子都比它早。
我认为替代品是 listobject 上的 ShowAutoFilter。 在您的代码中，lo.ShowAutoFilter 应返回 True 或 False，具体取决于是否设置了自动过滤器。

但是您代码的 rest 似乎也有问题。 测试If lo.Parent.autofilter.Filters(7).Criteria1 = "APGFORK" Then抛出错误并删除自动过滤器。

Answer 3

我最终采取了不同的方法：

Dim LastRowG As Long
LastRowG = Range("G" & Rows.Count).End(xlUp).Row

For i = 2 To LastRowG
If Range("G" & i).Value = "APGFORK" Then

    lo.Range.autofilter Field:=7, Criteria1:="APGFORK"
    
    Application.DisplayAlerts = False
       lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.autofilter.ShowAllData
    Else
    End If

Next i

这样，如果数据集中不存在“APGFORK”，它将继续前进而不会出现错误代码。

Answer 4

试试这个代码

Sub Test()
    Call DelFilterParam("BPL", "Table1", 7, "APGFORK")
End Sub

Sub DelFilterParam(ByVal wsName As String, ByVal stTable As String, ByVal iField As Integer, ByVal vCriteria As Variant)
    Dim x As Long, y As Long, z As Long
    With ThisWorkbook.Worksheets(wsName)
        With .ListObjects(stTable).DataBodyRange
            x = .Rows.Count: y = .Columns.Count
            .AutoFilter
            .AutoFilter Field:=iField, Criteria1:=vCriteria
            On Error Resume Next
                z = .SpecialCells(xlCellTypeVisible).Count
            On Error GoTo 0
            If (x * y) > z And z <> 0 Then .EntireRow.Delete
            .AutoFilter
        End With
    End With
End Sub