Excel VBA实现电影列表多条件模糊筛选及区间排序问题咨询

我们基于你现有的高级筛选架构做调整，不换用数组遍历方案，既能保证2000+条数据的筛选速度，又能满足所有功能需求，具体修改如下：

• 性能优化：保留Excel原生高级筛选逻辑，底层C++实现的筛选效率远高于VBA数组遍历，万条以内数据筛选耗时不会超过100ms
• A列全模糊匹配：自动给非空、非运算符开头的输入值前后加通配符*，实现全字段任意位置匹配
• B、C列区间筛选：识别> < >= <=开头的输入，直接作为筛选条件，无需加通配符，支持区间筛选需求
• G、H列多类型匹配：支持输入多个类型用英文逗号分隔，自动拆分为多个与逻辑的模糊条件，实现多类型同时匹配，且每个类型都支持任意位置匹配

'filter in row2
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long, i As Long, criteriaStr As String
    Dim arrCols, colIndex As Long
    ' 无需处理通配符的列：B=2、C=3，支持运算符筛选
    arrCols = Array(2, 3)
    
    ' 扩展筛选触发范围到H列
    If Not Application.Intersect(Range("A2:H2"), Range(Target.Address)) Is Nothing Then
        ' 关闭事件防止循环触发
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        ' 所有筛选条件为空时显示全部数据
        If WorksheetFunction.CountA(Range("A2:H2")) = 0 Then
            On Error Resume Next
            ActiveSheet.ShowAllData
            ActiveSheet.Rows.Hidden = False
            On Error GoTo 0
        Else
            ' 预处理所有筛选条件
            For colIndex = 1 To 8 ' A到H列
                criteriaStr = Cells(2, colIndex).Value
                If criteriaStr <> "" Then
                    ' 处理B、C列的区间筛选，不需要加通配符
                    If UBound(Filter(arrCols, colIndex)) > -1 Then
                        Cells(3, colIndex).Value = criteriaStr
                    ' 处理G、H列的多类型匹配
                    ElseIf colIndex = 7 Or colIndex = 8 Then
                        Dim typeArr, typeStr As String
                        typeArr = Split(criteriaStr, ",")
                        ' 多类型用与逻辑，每个类型加通配符
                        For i = LBound(typeArr) To UBound(typeArr)
                            typeArr(i) = "*" & Trim(typeArr(i)) & "*"
                        Next
                        Cells(3, colIndex).Value = Join(typeArr, "*")
                    ' 其他列（A列等）普通模糊匹配
                    Else
                        Cells(3, colIndex).Value = "*" & criteriaStr & "*"
                    End If
                Else
                    ' 条件为空时清空对应条件行
                    Cells(3, colIndex).Value = ""
                End If
            Next
            
            LR = UsedRange.Rows.Count
            ' 扩展筛选范围到H列
            Range("A1:H" & LR).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:H3")
        End If
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub 

' 新增H列排序按钮事件，如果需要H列排序功能可添加，不需要可删除
Private Sub ToggleButton8_Click()
    Dim Reihe As String
    Reihe = "H"
    If ToggleButton8.Value = False Then
        Call orderXA(Reihe)
    Else
        Call orderXD(Reihe)
    End If
End Sub

Private Sub ToggleButton1_Click()
Dim Reihe As String
Reihe = "A"
If ToggleButton1.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If

End Sub
Private Sub ToggleButton2_Click()
Dim Reihe As String
Reihe = "B"
If ToggleButton2.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub

Private Sub ToggleButton3_Click()
Dim Reihe As String
Reihe = "C"
If ToggleButton3.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub

Private Sub ToggleButton4_Click()
Dim Reihe As String
Reihe = "D"
If ToggleButton4.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub

Private Sub ToggleButton5_Click()
Dim Reihe As String
Reihe = "E"
If ToggleButton5.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub

Private Sub ToggleButton6_Click()
Dim Reihe As String
Reihe = "F"
If ToggleButton6.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub

Private Sub ToggleButton7_Click()
Dim Reihe As String
Reihe = "G"
If ToggleButton7.Value = False Then
Call orderXA(Reihe)
Else
Call orderXD(Reihe)
End If
End Sub
   

Sub orderXA(Reihe As String)
LR = UsedRange.Rows.Count  'zählt uf versteckte mit
Range("A3:H" & LR).Sort Key1:=Range(Reihe & "4"), order1:=xlAscending, Header:=xlYes

End Sub
Sub orderXD(Reihe As String)
LR = UsedRange.Rows.Count  'zählt uf versteckte mit
Range("A3:H" & LR).Sort Key1:=Range(Reihe & "4"), order1:=xlDescending, Header:=xlYes

End Sub

使用说明 #

• A列直接输入关键词即可实现全字段模糊匹配
• B、C列输入带运算符的条件即可实现区间筛选，比如>=2012、>7.5
• G、H列输入多个类型用英文逗号分隔即可实现多类型同时匹配，比如动作,犯罪、Action,Crime
• 多条件组合筛选功能和原逻辑一致，保持正常使用

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