捕获自动过滤器设置，关闭自动过滤，尝试重新应用设置，但未在多重选择过滤器上获得设置

问题描述

我设置了一个对象来捕获自动过滤器过滤器的所有设置：

'@Folder("Models")
Option Explicit

Private Type TAutoFilterModel
    FilterRange As Range
    Filters As Collection
End Type
Private this As TAutoFilterModel
Private Sub Class_Initialize()
    Set this.Filters = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Filters = nothing
End Sub

Public Property Get FilterRange() As Range
    Set FilterRange = this.FilterRange
End Property
Public Property Set FilterRange(ByVal RHS As Range)
    Set this.FilterRange = RHS
End Property
Public Property Get Filters() As Collection
    Set Filters = this.Filters
End Property
Public Property Set Filters(ByVal RHS As Collection)
    Set this.Filters = RHS
End Property
@H_502_4@

FilterModel：

'@Folder("Models")
Option Explicit

Private Type TFilterModel
    FilterColumn As Long
    IsOn As Boolean
    Criteria1 As Variant
    Operator As Variant
    Criteria2 As Variant
End Type
Private this As TFilterModel

Public Property Get FieldNumber() As Long
    FieldNumber = this.FilterColumn
End Property
Public Property Let FieldNumber(RHS As Long)
    this.FilterColumn = RHS
End Property
Public Property Get IsOn() As Boolean
    IsOn = this.IsOn
End Property
Public Property Let IsOn(ByVal RHS As Boolean)
    this.IsOn = RHS
End Property
Public Property Get Criteria1() As Variant
    Criteria1 = this.Criteria1
End Property
Public Property Let Criteria1(ByVal RHS As Variant)
    this.Criteria1 = RHS
End Property
Public Property Set Criteria1(ByVal RHS As Variant)
    Set this.Criteria1 = RHS
End Property
Public Property Get Operator() As Variant
'If IsObject(this.Operator) Then
'    Set Operator = this.Operator
'Else
    Operator = this.Operator
'End If
End Property
Public Property Let Operator(ByVal RHS As Variant)
    this.Operator = RHS
End Property
Public Property Set Operator(ByVal RHS As Variant)
    Set this.Operator = RHS
End Property
Public Property Get Criteria2() As Variant
'If IsObject(this.Criteria2) Then
'    Set Criteria2 = this.Criteria2
'Else
    Criteria2 = this.Criteria2
'End If
End Property
Public Property Let Criteria2(ByVal RHS As Variant)
    this.Criteria2 = RHS
End Property
Public Property Set Criteria2(ByVal RHS As Variant)
    Set this.Criteria2 = RHS
End Property
Public Property Get HasTwoCriteria() As Boolean
    HasTwoCriteria = Not IsEmpty(this.Criteria2)
End Property
@H_502_4@

实现：

Public Sub Main()
    Set currWS = Sheet1
    CaptureAutoFilters
    TurnOffAutoFilter
    MsgBox "Filters Captured,Autofilter Turned Off. Click OK",vbOKOnly
    RestoreAutoFilters
End Sub
Private Sub CaptureAutoFilters()
    With currWS.AutoFilter
        Set currAutoFilter = New AutoFilterModel
        Set currAutoFilter.FilterRange = .Range
    End With
    
    Dim FieldCounter As Long
    FieldCounter = 0
    Dim currFilter As Filter
    For Each currFilter In currWS.AutoFilter.Filters
        FieldCounter = FieldCounter + 1
        'currfilter.
        Dim currFilterModel As FilterModel
        Set currFilterModel = New FilterModel
        With currFilterModel
            .IsOn = currFilter.On
            .FieldNumber = FieldCounter
            If currFilter.On = True Then
                .Criteria1 = currFilter.Criteria1
                .Operator = currFilter.Operator
                On Error Resume Next
                    .Criteria2 = currFilter.Criteria2
                On Error GoTo 0
            End If
            currAutoFilter.Filters.Add currFilterModel
        End With
    Next
    
    Exit Sub
End Sub
Private Sub TurnOffAutoFilter()
    currWS.AutoFilterMode = False
End Sub
Private Sub RestoreAutoFilters()
    With currWS.Range(currAutoFilter.FilterRange.Address)
        Dim currFilterModel As FilterModel
        For Each currFilterModel In currAutoFilter.Filters
            If currFilterModel.IsOn Then
                If currFilterModel.HasTwoCriteria Then
                    .AutoFilter _
                        Field:=currFilterModel.FieldNumber,_
                        Criteria1:=currFilterModel.Criteria1,_
                        Operator:=currFilterModel.Operator,_
                        Criteria2:=currFilterModel.Criteria2
                Else
                    If IsArray(currFilterModel.Criteria1) Then
'                        Dim CriteriaString As String
'                        CriteriaString = Join(currFilterModel.Criteria1,",")
'                        CriteriaString = Replace(CriteriaString,"=",vbNullString)
'                        CriteriaString = Replace(CriteriaString,"""" & "," & """")
'                        Dim Counter As Long
'                        For Counter = LBound(currFilterModel.Criteria1) To UBound(currFilterModel.Criteria1)
'                            'Dim CriteriaString As String
'                            CriteriaString = CriteriaString & Replace(currFilterModel.Criteria1(Counter),"""") & """"
'                            If Counter <> UBound(currFilterModel.Criteria1) Then
'                                CriteriaString = CriteriaString & ","
'                            End If
'                        Next
'                        CriteriaString = Replace(CriteriaString,Chr(34) & Chr(34),Chr(34))
                        .AutoFilter _
                            Field:=currFilterModel.FieldNumber,_
                            Criteria1:=currFilterModel.Criteria1 'Application.WorksheetFunction.Transpose(currFilterModel.Criteria1) 'Array(CriteriaString) 'currFilterModel.Criteria1
                    Else
                        .AutoFilter _
                            Field:=currFilterModel.FieldNumber,_
                            Criteria1:=currFilterModel.Criteria1
                    End If
                End If
            End If
        Next
    End With
End Sub
@H_502_4@

如果自动过滤器的Criteria1@H_502_4@中有多个选择，则会在FilterModel.Criteria1@H_502_4@中存储一个数组，这是预期的结果；但是，当将该数组分配给自动过滤器Criteria1@H_502_4@时，只会选择该数组中的最后一项。我尝试将数组拆开并从中创建一个字符串，然后Criteria1:=Array(theString)@H_502_4@无效。我还尝试了WorksheetFunction.Transpose(FilterModel.Criteria1)@H_502_4@，该方法不起作用。

我很困惑...

更新： 我记录了一个宏以获取语法：Criteria1:=Array("a","b","c")@H_502_4@，所以我只是对其进行了硬编码-也不起作用！因此，宏记录器没有说实话。看中了。

解决方法

缺少的是未应用运算符。因此代码应为：

.AutoFilter _
                            Field:=currFilterModel.FieldNumber,_
                            Criteria1:=currFilterModel.Criteria1,_
                            Operator:=currFilterModel.Operator '<<<<-------