如果條件存在，VBA自動過濾

我已經錄制了宏來自動過濾和洗掉表中的行。但這不是動態的，因為如果給定表中不存在過濾條件，則宏將中斷。

我正在嘗試創建一個代碼，如果條件存在或不執行任何操作，它將自動過濾和洗掉行。我正在嘗試關注這篇文章，但我錯過了一些東西。請幫忙。

我的代碼沒有回傳錯誤，但也沒有做任何事情。我添加了訊息框以確保它實際上正在運行。

到目前為止，這是我的代碼：

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

uj5u.com熱心網友回復：

洗掉 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

uj5u.com熱心網友回復：

我不知道這是錯誤還是功能，但 .AutoFilterMode 似乎在 Excel 2013 或更高版本中一直回傳 False。我看到的所有使用 .AutoFilterMode 的例子都比這更早。
我認為替換是 listobject 上的 .ShowAutoFilter 。在您的代碼中， lo.ShowAutoFilter 應該回傳 True 或 False 取決于是否設定了自動過濾器。

但是您的其余代碼似乎也有問題。測驗 If lo.Parent.autofilter.Filters(7).Criteria1 = "APGFORK" Then 拋出錯誤并洗掉自動過濾器。

uj5u.com熱心網友回復：

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

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”，它將繼續前進而不會出現錯誤代碼。

uj5u.com熱心網友回復：

試試這個代碼

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

標籤：擅长 vba 自动过滤器

上一篇：VBA傳遞引數與.Onaction與引數

下一篇：獲取型別不匹配決議Web請求回應到vba中的xml物件