自动过滤，然后从表中删除行（如果有）

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。我看到的所有使用 .AutoFilterMode 的示例都早于此。
我认为替换是列表对象上的 .ShowAutoFilter 。在您的代码中，lo.ShowAutoFilter 应返回 True 或 False，具体取决于是否设置了自动筛选器。

但是你的其余代码似乎也有问题。考试

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