如何通过在单元格中输入文本来过滤 Table？

Question

我创建了一个 table 并且我只想过滤 33 列中的 4 列。

我所做的是分配了 5 个单元格（CountryName、ClientName、ProjNo 和 Date(frmDate - ToDate)）。在其中一个单元格中输入文本时，需要过滤 table，然后按一个按钮清除单元格和 table.

的过滤器

我面临两个问题：

当我按下清除按钮时，只有单元格被清除，table没有。
我输入国名的时候，table中的获奖日期也被过滤了，不知道为什么也被过滤了

注意：如果有更好的VBA代码通过在这些单元格中输入来过滤table，也很好。

工作表 1 的屏幕截图（过滤单元格和 Table）：

模块（FilteringModule）：

Option Explicit

Sub TableFill()
    Dim CountryName, ClientName, ProjNo As String
    Dim ToDate, FrDate As Date
    Dim MaxAmount, MinAmount As Integer
    Dim LastRow As Long
    With Sheet1
    
        LastRow = .Range("G99999").End(xlUp).Row
        If LastRow < 7 Then LastRow = 7
        If .Range("E7").Value = "Enter BV Country" Then CountryName = Empty Else: CountryName = .Range("E7").Value 'Country Name'
        If .Range("E9").Value = "Enter Client Name" Then ClientName = Empty Else: ClientName = .Range("E9").Value 'Client Name'
        If .Range("E11").Value = "Enter Proj No." Then ProjNo = Empty Else: ProjNo = .Range("E11").Value 'Proj Name'
        If .Range("E15").Value = "From Date" Then FrDate = "1/1/1900" Else: FrDate = .Range("E15").Value 'Date from'
        If .Range("E16").Value = "To Date" Then ToDate = "1/1/2030" Else: ToDate = .Range("E16").Value 'Date To'
    
    
        .Range("G6:AN" & LastRow).Select
        Selection.AutoFilter
        With .Range("G6:AN" & LastRow)
            If CountryName <> Empty Then .AutoFilter Field:=2, Criteria1:="=*" & CountryName & "*"
            If ClientName <> Empty Then .AutoFilter Field:=3, Criteria1:="=*" & ClientName & "*"
            If ProjNo <> Empty Then .AutoFilter Field:=5, Criteria1:="=*" & ProjNo & "*"
            .AutoFilter Field:=7, Criteria1:=">=" & FrDate, Operator:=xlAnd, Criteria2:="<=" & ToDate
    
        End With
    
    End With
    
End Sub
    
Sub ClearFilter()
    With Sheet1
        .Range("B4").Value = True
        .AutoFilterMode = False
        .Range("E7").Value = "Enter BV Country"
        .Range("E9").Value = "Enter Client Name"
        .Range("E11").Value = "Enter Proj No."
        .Range("E15").Value = "From Date"
        .Range("E16").Value = "To Date"
        .Range("B4").Value = False
    End With
End Sub

Sheet1 代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E7,E9,E11,E15:E16")) Is Nothing And Range("B4").Value = False Then
        TableFill
    End If

End Sub

Answer 1

对您的代码的一些建议：

始终将变量命名为有意义的名称，例如fromDate 而不是 frDate
至少使用基本的错误处理On error Goto
看看我是如何按步骤划分逻辑的（可以做得更进一步，但你明白了）
这一行：Dim CountryName, ClientName, ProjNo As String 只有 ProjNo 声明为字符串，其余为变体（所有变量都应为 As String）
可以参考ListObject(table)，它的范围不需要lastRow
最后，考虑将您的过滤器移动到另一个范围，当您应用它们时，它们会被隐藏

将您的工作表代码替换为：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Me.Range("E7,E9,E11,E15:E16")) Is Nothing Then
        ' Call the filter table procedure
        filterTable Me
    End If

End Sub

模块代码：

Option Explicit

Public Sub clearTableFilters()

    On Error GoTo CleanFail
    
    ' Disable events so the filter table is not triggered everytime you change the filters' values
    Application.EnableEvents = False
    
    ' Set default values
    With Sheet1
        .Range("E7").Value = "Enter BV Country"
        .Range("E9").Value = "Enter Client Name"
        .Range("E11").Value = "Enter Proj No."
        .Range("E15").Value = "From Date"
        .Range("E16").Value = "To Date"
    End With
    
    ' Filter table
    filterTable Sheet1
    
CleanExit:
    ' Reenable events
    Application.EnableEvents = True
    Exit Sub
        
CleanFail:
    MsgBox "Error: " & Err.Description
    GoTo CleanExit
    
End Sub

Public Sub filterTable(ByVal sourceSheet As Worksheet)

    On Error GoTo CleanFail
        
    ' Get filter values
    With sourceSheet
        Dim countryName As String
        countryName = .Range("E7").Value
        
        Dim clientName As String
        clientName = .Range("E9").Value
        
        Dim projectNo As String
        projectNo = .Range("E11").Value
        
        Dim fromDate As Variant
        fromDate = .Range("E15").Value
        
        Dim toDate As Variant
        toDate = .Range("E16").Value

    End With
    
    ' Check if it's applying filters
    Dim applyCountryFilter As Boolean
    applyCountryFilter = getFilterStatus(countryName, "Enter BV Country", 1)
    
    Dim applyClientNameFilter As Boolean
    applyClientNameFilter = getFilterStatus(clientName, "Enter Client Name", 1)
    
    Dim projectNoFilter As Boolean
    projectNoFilter = getFilterStatus(projectNo, "Enter Proj No.", 1)
    
    Dim fromDateFilter As Boolean
    fromDateFilter = getFilterStatus(fromDate, "From Date", 2)
    
    Dim toDateFilter As Boolean
    toDateFilter = getFilterStatus(toDate, "To Date", 2)
    
    Dim applyRemoveFilters As Boolean
    applyRemoveFilters = (applyCountryFilter Or applyClientNameFilter Or projectNoFilter Or fromDateFilter Or toDateFilter)

    ' Define table to be filtered
    Dim targetTable As ListObject
    Set targetTable = Range("Table1").ListObject
    
    ' Select if applying or removing filters
    Select Case applyRemoveFilters
    Case True ' Apply
    
        ' Apply string filters
        If applyCountryFilter Then applyRemoveAutoFilter targetTable, 2, applyCountryFilter, "*" & countryName & "*"
        
        If applyClientNameFilter Then applyRemoveAutoFilter targetTable, 3, applyClientNameFilter, "*" & clientName & "*"
        
        If projectNoFilter Then applyRemoveAutoFilter targetTable, 5, projectNoFilter, "*" & projectNo & "*"

        ' Apply date filters
        Select Case True
        Case (fromDateFilter And toDateFilter)
            targetTable.Range.AutoFilter Field:=7, Criteria1:=">=" & fromDate, Operator:=xlAnd, Criteria2:="<=" & toDate
        Case (fromDateFilter = True And toDateFilter = False)
            targetTable.Range.AutoFilter Field:=7, Criteria1:=">=" & fromDate
        Case (fromDateFilter = False And toDateFilter = True)
            targetTable.Range.AutoFilter Field:=2, Criteria1:="<=" & toDate
        Case Else
            targetTable.Range.AutoFilter Field:=7
        End Select

    Case False ' Remove
        targetTable.AutoFilter.ShowAllData
        
    End Select

CleanExit:
    Exit Sub
        
CleanFail:
    MsgBox "Error: " & Err.Description
    GoTo CleanExit
    
End Sub

Private Function getFilterStatus(ByVal fieldValue As Variant, ByVal fieldDefaultValue As String, ByVal filterType As Long) As Boolean
    
    Select Case filterType
    Case 1 ' String
        getFilterStatus = Not (fieldValue = vbNullString Or LCase(fieldValue) = LCase(fieldDefaultValue))
    Case 2 ' Date
        getFilterStatus = Not (Not IsDate(fieldValue) Or ((IsDate(fieldValue) And fieldValue = 0)) Or LCase(fieldValue) = LCase(fieldDefaultValue))
    End Select

End Function

Private Function getFilterDate(ByVal sourceDate As Variant) As Date

    Select Case IsDate(sourceDate)
    Case True
        getFilterDate = sourceDate
    Case False
        getFilterDate = 0
    End Select

End Function

Private Sub applyRemoveAutoFilter(ByVal targetTable As ListObject, ByVal columnNo As Long, ByVal applyFilter As Boolean, Optional ByVal criteriaValue As Variant)

    Select Case applyFilter
    Case True
        targetTable.Range.AutoFilter Field:=columnNo, Criteria1:=criteriaValue
    Case False
        targetTable.Range.AutoFilter Field:=columnNo
    End Select

End Sub

调整清除过滤器按钮以调用 clearTableFilters 过程

如果有效请告诉我

如何通过在单元格中输入文本来过滤 Table？

How to filter Table by entering text in cells?

excel

vba

filtering

cell