在 Excel VBA 中，如何保存/恢复用户定义的过滤器？

In Excel VBA, how do I save / restore a user-defined filter?

提问by user1238769

How do I save and then reapply the current filter using VBA?

如何使用 VBA 保存然后重新应用当前过滤器？

In Excel 2007 VBA, I'm trying to

在 Excel 2007 VBA 中，我试图

1. Save whatever filter the user has on the current worksheet
2. Clear the filter
3. "Do stuff"
4. Reapply the saved filter

1. 保存用户在当前工作表上的任何过滤器
2. 清除过滤器
3. “做东西”
4. 重新应用保存的过滤器

回答by Reafidy

Have a look at Capture Autofilter state

看看捕获自动过滤器状态

To prevent link rot, here is the code (credit to original author):

为了防止链接腐烂，这里是代码（归功于原作者）：

Works with Excel 2010, just delete the commented line marked.

适用于 Excel 2010，只需删除标记的注释行。

Sub ReDoAutoFilter()
    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer

    Set w = ActiveSheet

    ' Capture AutoFilter settings
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Criteria1
                        If .Operator Then
                            filterArray(f, 2) = .Operator
                            filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
                        End If
                    End If
                End With
            Next f
        End With
    End With

    'Remove AutoFilter
    w.AutoFilterMode = False

    ' Your code here

    ' Restore Filter settings
    For col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col
End Sub

回答by Phil Spencer

Above code does not work in Excel 2010 as it has more possible filter types. This may be true for Excel 2007 too.

上面的代码在 Excel 2010 中不起作用，因为它有更多可能的过滤器类型。对于 Excel 2007 也可能如此。

Excel 2010 (XL14) introduces a number of changes over XL 2003 (XL11)

Excel 2010 (XL14) 对 XL 2003 (XL11) 进行了许多更改

• .Operator is no longer True/False but an enumeration. There is still a FALSE (=0) value, which for some reason cannot be set using Operator:= when setting Criteria1. The old TRUE values remain as xlAnd and xlOr (1 and 2).

• The selected ranges (xlTop10Items, xlBottom10Items, xlTop10Percent, xlBottom10Percent) appear to be implemented as a .Operator=FALSE type that will achieve the desired result at the time the filter was set, but with a non-zero .Operator. However you cannot use Operator:= when restoring the filter. It becomes a fixed range rather than (say) top 10.

• For .Operator=xlFilterValues, .Criteria1 is an array of the selected values, and seems to be restored OK with the expected statement.

• The criteria for Format filters (eg cells with green fill - new in XL 2010 over XL 2007?) apparently can't be restored using the .Criteria1 mechanisms. The operator can be restored, but the pass filter isn't restored so it filters out everything. Better to just leave it off.

• .Operator 不再是 True/False 而是一个枚举。仍然存在一个 FALSE (=0) 值，由于某种原因，在设置 Criteria1 时无法使用 Operator:= 设置该值。旧的 TRUE 值保持为 xlAnd 和 xlOr（1 和 2）。

• 选定的范围（xlTop10Items、xlBottom10Items、xlTop10Percent、xlBottom10Percent）似乎是作为 .Operator=FALSE 类型实现的，它将在设置过滤器时实现所需的结果，但具有非零的 .Operator。但是，您不能在恢复过滤器时使用 Operator:=。它变成了一个固定的范围，而不是（比如说）前 10 名。

• 对于 .Operator=xlFilterValues，.Criteria1 是所选值的数组，并且似乎可以通过预期的语句恢复正常。

• 格式过滤器的标准（例如带有绿色填充的单元格 - XL 2010 中的新内容超过 XL 2007？）显然无法使用 .Criteria1 机制恢复。算子可以恢复，但通过过滤器没有恢复，所以它过滤掉了所有东西。最好把它关掉。

Extended version of above, implemented as SaveFilters() and RestoreFilters()

上面的扩展版本，实现为 SaveFilters() 和 RestoreFilters()

I have used literal numbers rather than the enumerations (xlAnd, xlOr etc) so that the code has a fighting chance of being usable in XL 2003 which didn't have those enumerations. Some of the restoration CASE statements are repeated code; this is to simplify later extensions if someone finds a way to bypass some of the limitations above.

我使用了文字数字而不是枚举（xlAnd、xlOr 等），因此代码有机会在没有这些枚举的 XL 2003 中使用。部分恢复CASE语句是重复代码；如果有人找到绕过上述某些限制的方法，这是为了简化以后的扩展。

' Usage example:
'    Dim strAFilterRng As String    ' Autofilter range
'    Dim varFilterCache()           ' Autofilter cache
'    ' [set up code]
'    Set wksAF = Worksheets("Configuration")
'
'    ' Check for autofilter, turn off if active..
'    SaveFilters wksAF, strAFilterRng, varFilterCache
'    [code with filter off]
'    [set up special auto-filter if required]
'    [code with filter on as applicable]
'    ' Restore original autofilter if present ..
'    RestoreFilters wksAF, strAFilterRng, varFilterCache

'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      SaveFilters
' Purpose:  Save filter on worksheet
' Returns:  wks.AutoFilterMode when function entered
'
' Arguments:
'   [Name]      [Type]  [Description]
'   wks         I/P     Worksheet that filter may reside on
'   FilterRange O/P     Range on which filter is applied as string; "" if no filter
'   FilterCache O/P     Variant dynamic array in which to save filter
'
' Author:   Based on MS Excel AutoFilter Object help file
'
' Modifications:
' 2006/12/11 Phil Spencer: Adapted as general purpose routine
' 2007/03/23 PJS: Now turns off .AutoFilterMode
' 2013/03/13 PJS: Initial mods for XL14, which has more operators
'
' Comments:
'----------------------------
Function SaveFilters(wks As Worksheet, FilterRange As String, FilterCache()) As Boolean
    Dim ii As Long

    FilterRange = ""    ' Alternative signal for no autofilter active
    SaveFilters = wks.AutoFilterMode
    If SaveFilters Then
        With wks.AutoFilter
            FilterRange = .Range.Address
            With .Filters
                ReDim FilterCache(1 To .Count, 1 To 3)
                For ii = 1 To .Count
                    With .Item(ii)
                        If .On Then
#If False Then ' XL11 code
                            FilterCache(ii, 1) = .Criteria1
                            If .Operator Then
                                FilterCache(ii, 2) = .Operator
                                FilterCache(ii, 3) = .Criteria2
                            End If
#Else   ' first pass XL14
                            Select Case .Operator

                            Case 1, 2   'xlAnd, xlOr
                                FilterCache(ii, 1) = .Criteria1
                                FilterCache(ii, 2) = .Operator
                                FilterCache(ii, 3) = .Criteria2

                            Case 0, 3 To 7 ' no operator, xlTop10Items, _
 xlBottom10Items, xlTop10Percent, xlBottom10Percent, xlFilterValues
                                FilterCache(ii, 1) = .Criteria1
                                FilterCache(ii, 2) = .Operator

                            Case Else    ' These are not correctly restored; there's someting in Criteria1 but can't save it.
                                FilterCache(ii, 2) = .Operator
                                ' FilterCache(ii, 1) = .Criteria1   ' <-- Generates an error
                                ' No error in next statement, but couldn't do restore operation
                                ' Set FilterCache(ii, 1) = .Criteria1

                            End Select
#End If
                        End If
                    End With ' .Item(ii)
                Next
            End With ' .Filters
        End With ' wks.AutoFilter
        wks.AutoFilterMode = False  ' turn off filter
    End If ' wks.AutoFilterMode
End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      RestoreFilters
' Purpose:  Restore filter on worksheet
' Arguments:
'   [Name]      [Type]  [Description]
'   wks         I/P     Worksheet that filter resides on
'   FilterRange I/P     Range on which filter is applied
'   FilterCache I/P     Variant dynamic array containing saved filter
'
' Author:   Based on MS Excel AutoFilter Object help file
'
' Modifications:
' 2006/12/11 Phil Spencer: Adapted as general purpose routine
' 2013/03/13 PJS: Initial mods for XL14, which has more operators
'
' Comments:
'----------------------------
Sub RestoreFilters(wks As Worksheet, FilterRange As String, FilterCache())
    Dim col As Long

    wks.AutoFilterMode = False ' turn off any existing auto-filter
    If FilterRange <> "" Then
        wks.Range(FilterRange).AutoFilter ' Turn on the autofilter
        For col = 1 To UBound(FilterCache(), 1)

#If False Then  ' XL11
            If Not IsEmpty(FilterCache(col, 1)) Then
                If FilterCache(col, 2) Then
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1), _
                            Operator:=FilterCache(col, 2), _
                        Criteria2:=FilterCache(col, 3)
                Else
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1)
                End If
            End If
#Else

            If Not IsEmpty(FilterCache(col, 2)) Then
                Select Case FilterCache(col, 2)

                Case 0  ' no operator
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1) ' Do NOT reload 'Operator'

                Case 1, 2   'xlAnd, xlOr
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1), _
                        Operator:=FilterCache(col, 2), _
                        Criteria2:=FilterCache(col, 3)

                Case 3 To 6 ' xlTop10Items, xlBottom10Items, xlTop10Percent, xlBottom10Percent
#If True Then
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1) ' Do NOT reload 'Operator' , it doesn't work
                    ' wks.AutoFilter.Filters.Item(col).Operator = FilterCache(col, 2)
#Else ' Trying to restore Operator as well as Criteria ..
                    ' Including the 'Operator:=' arguement leads to error.
                    ' Criteria1 is expressed as if for a FALSE .Operator
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1), _
                        Operator:=FilterCache(col, 2)
#End If

                Case 7  'xlFilterValues
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Criteria1:=FilterCache(col, 1), _
                        Operator:=FilterCache(col, 2)

#If False Then ' Switch on filters on cell formats
' These statements restore the filter, but cannot reset the pass Criteria, so the filter hides all data.
' Leave it off instead.
                Case Else   ' (Various filters on data format)
                    wks.Range(FilterRange).AutoFilter field:=col, _
                        Operator:=FilterCache(col, 2)
#End If ' Switch on filters on cell formats

                End Select
            End If

#End If     ' XL11 / XL14
        Next col
    End If
End Sub

I've seen a suggestion elsewhere to achieve the required outcome by

我在其他地方看到过一个建议，可以通过以下方式实现所需的结果

• Set up a custom view (using some improbable name to avoid overwriting things)

• Execute code with autofilter off or modified

• .Show the view (restore previous layout)

• .Delete the view (to remove redundant data).

• 设置自定义视图（使用一些不太可能的名称以避免覆盖内容）

• 在关闭或修改自动过滤器的情况下执行代码

• .显示视图（恢复以前的布局）

• .删除视图（删除冗余数据）。

Good luck folks..

祝大家好运。。

回答by PeterH

People looking for saving and restoring listobject / table filters (tested in Office 2007).

人们正在寻找保存和恢复列表对象/表过滤器（在 Office 2007 中测试）。

I have made some changes to the very good code above of Phil Spencer. Now you only need to add a listobject to the function and then it works for saving and restoring listobject filters as well:

我对 Phil Spencer 上面非常好的代码做了一些更改。现在您只需要向函数添加一个列表对象，然后它也可以用于保存和恢复列表对象过滤器：

'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      SaveListObjectFilters
' Purpose:  Save filter on worksheet
' Returns:  wks.AutoFilterMode when function entered
' Source: http://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-        restore-a-user-defined-filter
'
' Arguments:
'   [Name]      [Type]  [Description]
'   wks         I/P     Worksheet that filter may reside on
'   FilterRange O/P     Range on which filter is applied as string; "" if no filter
'   FilterCache O/P     Variant dynamic array in which to save filter
'
' Author:   Based on MS Excel AutoFilter Object help file
'
' Modifications:
' 2006/12/11 Phil Spencer: Adapted as general purpose routine
' 2007/03/23 PJS: Now turns off .AutoFilterMode
' 2013/03/13 PJS: Initial mods for XL14, which has more operators
' 2013/05/31 P.H.: Changed to save list-object filters

Function SaveListObjectFilters(lo As ListObject, FilterCache()) As Boolean
Dim ii As Long

filterRange = ""
    With lo.AutoFilter
        filterRange = .Range.Address
        With .Filters
            ReDim FilterCache(1 To .Count, 1 To 3)
            For ii = 1 To .Count
                With .Item(ii)
                    If .On Then
#If False Then ' XL11 code
                        FilterCache(ii, 1) = .Criteria1
                        If .Operator Then
                            FilterCache(ii, 2) = .Operator
                            FilterCache(ii, 3) = .Criteria2
                        End If
#Else   ' first pass XL14
                        Select Case .Operator

                        Case 1, 2   'xlAnd, xlOr
                            FilterCache(ii, 1) = .Criteria1
                            FilterCache(ii, 2) = .Operator
                            FilterCache(ii, 3) = .Criteria2

                        Case 0, 3 To 7 ' no operator, xlTop10Items, _
xlBottom10Items, xlTop10Percent, xlBottom10Percent, xlFilterValues
                            FilterCache(ii, 1) = .Criteria1
                            FilterCache(ii, 2) = .Operator

                        Case Else    ' These are not correctly restored; there's someting in Criteria1 but can't save it.
                            FilterCache(ii, 2) = .Operator
                            ' FilterCache(ii, 1) = .Criteria1   ' <-- Generates an error
                            ' No error in next statement, but couldn't do restore operation
                            ' Set FilterCache(ii, 1) = .Criteria1

                        End Select
#End If
                    End If
                End With ' .Item(ii)
            Next
        End With ' .Filters
    End With ' wks.AutoFilter
End Function


'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      RestoreListObjectFilters
' Purpose:  Restore filter on listobject
' Source: http://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter
' Arguments:
'   [Name]      [Type]  [Description]
'   wks         I/P     Worksheet that filter resides on
'   FilterRange I/P     Range on which filter is applied
'   FilterCache I/P     Variant dynamic array containing saved filter
'
' Author:   Based on MS Excel AutoFilter Object help file
'
' Modifications:
' 2006/12/11 Phil Spencer: Adapted as general purpose routine
' 2013/03/13 PJS: Initial mods for XL14, which has more operators
' 2013/05/31 P.H.: Changed to restore list-object filters
'
' Comments:
'----------------------------
Sub RestoreListObjectFilters(lo As ListObject, FilterCache())
Dim col As Long

If lo.Range.Address <> "" Then
    For col = 1 To UBound(FilterCache(), 1)

#If False Then  ' XL11
        If Not IsEmpty(FilterCache(col, 1)) Then
            If FilterCache(col, 2) Then
                lo.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1), _
                        Operator:=FilterCache(col, 2), _
                    Criteria2:=FilterCache(col, 3)
            Else
                lo.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1)
            End If
        End If
#Else

        If Not IsEmpty(FilterCache(col, 2)) Then
            Select Case FilterCache(col, 2)

            Case 0  ' no operator
                lo.Range.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1) ' Do NOT reload 'Operator'

            Case 1, 2   'xlAnd, xlOr
                lo.Range.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1), _
                    Operator:=FilterCache(col, 2), _
                    Criteria2:=FilterCache(col, 3)

            Case 3 To 6 ' xlTop10Items, xlBottom10Items, xlTop10Percent,     xlBottom10Percent
#If True Then
                lo.Range.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1) ' Do NOT reload 'Operator' , it doesn't work
                ' wks.AutoFilter.Filters.Item(col).Operator = FilterCache(col, 2)
#Else ' Trying to restore Operator as well as Criteria ..
                ' Including the 'Operator:=' arguement leads to error.
                ' Criteria1 is expressed as if for a FALSE .Operator
                lo.Range.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1), _
                    Operator:=FilterCache(col, 2)
#End If

            Case 7  'xlFilterValues
                lo.Range.AutoFilter field:=col, _
                    Criteria1:=FilterCache(col, 1), _
                    Operator:=FilterCache(col, 2)

#If False Then ' Switch on filters on cell formats
' These statements restore the filter, but cannot reset the pass Criteria, so the filter hides all data.
' Leave it off instead.
            Case Else   ' (Various filters on data format)
                lo.RangeAutoFilter field:=col, _
                    Operator:=FilterCache(col, 2)
#End If ' Switch on filters on cell formats

            End Select
        End If

#End If     ' XL11 / XL14
    Next col
End If
End Sub

回答by Cyious

Setting custom views works surprisingly well for this. I get a message that some view info could not be applied (Excel 2010) but checking the filters, everything looks good. Depending on the situation, it might be worth taking this approach. Thanks to Phil Spencer for the idea!

设置自定义视图对此非常有效。我收到一条消息，提示无法应用某些视图信息 (Excel 2010)，但检查过滤器，一切看起来都不错。根据情况，可能值得采用这种方法。感谢菲尔斯宾塞的想法！

'[whatever code you want to run before capturing autofilter settings]

wkbExample.CustomViews.Add ViewName:="cvwAutoFilterSettings", RowColSettings:=True

'[whatever code you want to run with either your autofilter or no autofilter]

wkbExample.CustomViews("cvwAutoFilterSettings").Show
wkbExample.CustomViews("cvwAutoFilterSettings").Delete

'[whatever code you want to run after restoring original autofilter settings]

回答by vba_noob

Sub ReDoAutoFilter()
    Dim w As Worksheet
    Dim filterArray() As Variant
    Dim currentFiltRange As Variant
    Dim col As Integer

    Set w = ActiveSheet

currentFiltRange = w.AutoFilter.Range.Address

' Captures AutoFilter settings
    With w.AutoFilter

        With .Filters

            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        If IsArray(.Criteria1) Then
                            filterArray(f, 1) = .Criteria1
                            CriteriaOne = "=Array(" & Replace(Replace(Join(.Criteria1, ","), "=", Chr(34)), ",", Chr(34) & ",") & Chr(34) & ")"
                            Debug.Print "CriteriaOne's Field " & f & " is an Array consisting of:"
                            Debug.Print "  " & CriteriaOne

                            filterArray(f, 2) = .Operator
                            Debug.Print "Field:" & f & "'s .Operator value is: " & .Operator
                            Debug.Print "  " & " (7 =xlFilterValues)"

                        ElseIf Not IsArray(.Criteria1) Then
                                   filterArray(f, 1) = .Criteria1
                                   Debug.Print "Field:" & f & "'s .Criteria1 is: " & .Criteria1

                                   If .Operator Then
                                       '2nd Dimension, 2nd column/index
                                        filterArray(f, 2) = .Operator
                                        Debug.Print "Field:" & f & "'s .Operator is: " & .Operator
                                        Debug.Print "  " & " (2=xlOr, 1=xlAnd)"

                                        '2nd Dimension, 3rd column/index
                                        filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
                                        Debug.Print "Field:" & f & "'s .Criteria2 is: " & .Criteria2

                                    End If
                        End If
                    End If
                End With

            Next f
        End With

    End With





' Your code here.


' Prevents Worksheet_Calculate() from re-triggering (If applicable) before the completion of this code.
Application.EnableEvents = False


' Restores Filter settings
    For f = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(f, 1)) Then
            If filterArray(f, 2) Then
            w.Range(currentFiltRange).AutoFilter Field:=f, _
                Criteria1:=filterArray(f, 1), _
                Operator:=filterArray(f, 2), _
                Criteria2:=filterArray(f, 3)

            Else
                w.Range(currentFiltRange).AutoFilter Field:=f, _
                Criteria1:=filterArray(f, 1)
            End If
        End If
    Next f

Application.EnableEvents = True

End Sub

I added array functionality to Reafidy's original code and tweaked restore's integer variable to work for me.

我在 Reafidy 的原始代码中添加了数组功能，并调整了 restore 的整数变量来对我来说有效。