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

Question

我创建了一个表，我只想按 33 列中的 4 列进行过滤。

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

我面临两个问题：

1. 当我按下清除按钮时，只有单元格会被清除，而表格不会。

2. 当我在国家名称中输入数据时，表格中给出的授予日期也被过滤了，我不知道为什么它也会被过滤。

注意：如果有更好的 VBA 代码通过输入这些单元格来过滤表格，也可以。

Sheet1 的屏幕截图（过滤单元格和表格）：

模块（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（表），它的范围不需要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 过程

---

让我知道它是否有效