如何解决Excel多标签列内置过滤按组合而非单个标签显示的问题？

我有一个内容目录数据表，包含等级列（初级、中级等）、多关键词标签列及其他列。使用Excel内置过滤功能时，标签列只会显示所有唯一的标签组合，而非单个标签，根本没法正常按单个标签过滤。试了好几个VBA代码都没成功，想要一个团队里新手也能轻松上手用的解决方案。

以下是我试过的VBA代码：

Dim PreviousCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lb As MSForms.ListBox
    Dim lastRowH As Long
    Dim i As Long, j As Long
    Dim SelectedItems As String
    
    ' 关闭事件和屏幕更新以降低资源消耗
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set lb = Me.OLEObjects("ListBox1").Object
    
    ' 确定H列最后一行数据行号
    lastRowH = Me.Cells(Me.Rows.Count, "H").End(xlUp).Row
    If lastRowH < 3 Then lastRowH = 3

    ' 若离开之前选中的H列单元格，确认选择内容
    If Not PreviousCell Is Nothing Then
        If Not Intersect(PreviousCell, Me.Range("H3:H" & lastRowH)) Is Nothing Then
            SelectedItems = ""
            For i = 0 To lb.ListCount - 1
                If lb.Selected(i) Then
                    If SelectedItems = "" Then
                        SelectedItems = lb.List(i)
                    Else
                        SelectedItems = SelectedItems & ", " & lb.List(i)
                    End If
                End If
            Next i
            
            PreviousCell.Value = SelectedItems
        End If
    End If

    ' 处理新选中的H3:H(lastRowH)范围内的单元格
    If Not Intersect(Target, Me.Range("H3:H" & lastRowH)) Is Nothing Then
        With lb
            .Top = Target.Top
            .Left = Target.Left
            .Width = Target.Width
            .Height = Target.Height * 6 ' 可按需调整高度
            .Visible = True
            
            ' 清除之前的选择
            For j = 0 To .ListCount - 1
                .Selected(j) = False
            Next j
            
            ' 若单元格已有内容，重新选中对应项
            If Target.Value <> "" Then
                Dim arrValues As Variant, v
                arrValues = Split(Target.Value, ",")
                For Each v In arrValues
                    For j = 0 To .ListCount - 1
                        If Trim(.List(j)) = Trim(v) Then
                            .Selected(j) = True
                        End If
                    Next j
                Next v
            End If
        End With
    Else
        lb.Visible = False
    End If

    Set PreviousCell = Target
    
    ' 恢复设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchTerm As String
    Dim rng As Range

    Set ws = Me
    
    ' 仅当H1单元格内容变化时执行
    If Intersect(Target, ws.Range("H1")) Is Nothing Then Exit Sub
    
    ' 关闭事件、屏幕更新和自动计算
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    searchTerm = Trim(ws.Range("H1").Value)
    
    ' 确定H列最后一行数据行号
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    If lastRow < 3 Then lastRow = 3

    Set rng = ws.Range("H2:H" & lastRow)
    
    ' 若搜索词为空，清除现有筛选
    If searchTerm = "" Then
        If ws.FilterMode Then
            ws.ShowAllData
        End If
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
    End If

    ' 若未开启自动筛选，先开启
    If Not ws.AutoFilterMode Then
        rng.AutoFilter
    Else
        ' 清除H列现有筛选条件
        rng.AutoFilter Field:=1
    End If
    
    ' 应用包含匹配筛选
    rng.AutoFilter Field:=1, Criteria1:"*" & searchTerm & "*"
    
    ' 恢复设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

内容的提问来源于stack exchange，提问作者David Epstein