Excel自带筛选功能，如：

但:无法快速、组合筛选。

编一个模块如下：

选中希望筛选的列（任意单元格），运行后显示：

当再次载入时，可以读取上次选中的项，便于二次筛选。

所的的代码如下：

Private Sub UserForm_Initialize()

    Dim currentCell As Range
    Dim uniqueValues As Collection
    Dim rng As Range
    Dim i As Long
    Dim lvItem As ListItem
    Dim ws As Worksheet
    Dim rowIndex As Long    
    
    Me.ListView1.ColumnHeaders.Add , , "序号", 60
    Me.ListView1.ColumnHeaders.Add , , "单元格值", Me.ListView1.Width - 70    
    Me.ListView1.View = lvwReport
    Me.ListView1.FullRowSelect = True
    Me.ListView1.CheckBoxes = True
    Me.ListView1.LabelEdit = lvwAutomatic        
    ' 获取当前工作表和当前选中单元格
    Set ws = ActiveWorkbook.ActiveSheet
    Set currentCell = ws.Cells(ActiveCell.row, ActiveCell.Column)    
    ' 获取当前列,不包括第一行
    Set rng = ws.Cells(ActiveCell.currentRegion.Range("A1").row, ActiveCell.Column).Resize(ActiveCell.currentRegion.Rows.Count - 1, 1).Offset(1, 0) ' 忽略第一行
    
    ' 创建集合来存储唯一值
    Set uniqueValues = New Collection
    On Error Resume Next
    
    Dim cell As Range    
    For Each cell In rng
        If cell.Value <> "" Then
            uniqueValues.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0    
    ' 填充
    ListView1.ListItems.Clear
    For i = 1 To uniqueValues.Count
        Set lvItem = ListView1.ListItems.Add(, , Format(i, "000")) ' 第一列，000格式序号
        lvItem.SubItems(1) = uniqueValues(i) ' 第二列，唯一值
    Next i    
    ' 找到显示值
    Set uniqueValues = New Collection
    On Error Resume Next
     
    For Each cell In rng
        If ws.Rows(cell.row).Hidden = False Then
            uniqueValues.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0       
    ' 标识ListViewItem
    For Each lvItem In ListView1.ListItems
        If IsInCollection(uniqueValues, lvItem.ListSubItems(1).text) Then
            lvItem.Checked = True
        End If
    Next lvItem        
End Sub


Private Sub CheckBox1_Click()
    Dim objListViewItem As ListItem
    If Me.CheckBox1.Value Then    
        For Each objListViewItem In Me.ListView1.ListItems
            objListViewItem.Checked = True
        Next
    Else    
        For Each objListViewItem In Me.ListView1.ListItems
            objListViewItem.Checked = False
        Next
    End If
End Sub

Private Sub 确定_Click()

    Dim selectedItems As Collection
    Dim lvItem As ListItem
    Dim rng As Range
    Dim ws As Worksheet
    Dim cell As Range
    Dim currentRegion As Range
    Dim currentCol As Long
    Dim firstDataRow As Long
    Dim totalRows As Long
    
    Set ws = ActiveWorkbook.ActiveSheet
    currentCol = ActiveCell.Column    
    ' 获取当前单元格所在区域，不包括第一行
    Set currentRegion = ActiveCell.currentRegion    
    firstDataRow = currentRegion.row + 1
    totalRows = currentRegion.Rows.Count - 1
    
    ' 创建集合，存储选中的ListView Item
    Set selectedItems = New Collection
    For Each lvItem In ListView1.ListItems    
        If lvItem.Checked Then
            selectedItems.Add lvItem.SubItems(1)
        End If        
    Next lvItem
    
    ' 如果没有选中，取消隐藏所有
    If selectedItems.Count = 0 Then    
        currentRegion.Rows.Hidden = False
        Exit Sub        
    End If
    
    ' 使用Resize调整范围
    Application.ScreenUpdating = False    
    ActiveCell.currentRegion.Range("A1").Select    
    Set rng = ws.Cells(ActiveCell.currentRegion.Range("A1").row, currentCol).Resize(totalRows, 1).Offset(1, 0) ' 忽略第一行
    For Each cell In rng.Cells
        If Not IsEmpty(cell.Value2) And VarType(cell.Value2) <> vbError Then
            If CStr(cell.Value2) <> "" Then            
                If Not IsInCollection(selectedItems, cell.Value2) Then
                    cell.EntireRow.Hidden = True
                Else
                    cell.EntireRow.Hidden = False
                End If                
            End If            
        End If        
    Next cell    
    Application.ScreenUpdating = True
End Sub

' 判断值是否在集合中
Private Function IsInCollection(col As Collection, val As Variant) As Boolean
    Dim item As Variant
    For Each item In col
        If item = val Then
            IsInCollection = True
            Exit Function
        End If
    Next item
    IsInCollection = False
End Function

Private Sub 添加_Click()    
    ' 可以多次添加，较系统自动筛选，更易于使用
    ' 适用多个场景    
    Dim lvItem As ListItem    
    Dim strKeyWord As String
    strKeyWord = Trim(Me.TextBoxKeyWord.text)    
    If strKeyWord = "" Then Exit Sub    
    For Each lvItem In ListView1.ListItems
        If InStr(1, lvItem.ListSubItems(1).text, strKeyWord) > 0 Then
            lvItem.Checked = True
        End If
    Next lvItem
End Sub