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

Posted 2023-02-27

技术标签:

【中文标题】在 Excel VBA 中，如何保存/恢复用户定义的过滤器？【英文标题】：In Excel VBA, how do I save / restore a user-defined filter? 【发布时间】：2012-03-18 08:22:30 【问题描述】：

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

在 Excel 2007 VBA 中，我正在尝试

保存用户在当前工作表上的任何过滤器清除过滤器 “做事” 重新应用保存的过滤器

【问题讨论】：

【参考方案1】：

看看Capture Autofilter state

为防止链接失效，代码如下（感谢原作者）：

适用于 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

【讨论】：

做得很好。从HERE 看到这个我打算写一个，但后来想让我试着搜索一下它是否已经被 SO 覆盖。这是一段非常好的代码，我已经使用了很长时间，但是，我遇到了一个可能的问题：请参阅***.com/questions/22307045/… 了解详细信息。跨度> @readidy 如何编辑此代码以仅将过滤器保存为一个宏，手动执行某些操作而不是重新应用过滤器作为其他宏？【参考方案2】：

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

Excel 2010 (XL14) 与 XL 2003 (XL11) 相比引入了许多变化

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

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

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

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

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

我使用了文字数字而不是枚举（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

我在其他地方看到了通过

实现所需结果的建议

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

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

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

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

祝大家好运..

【讨论】：

这很棒。谢谢！这不考虑对象过滤。如果过滤条件是一个对象，例如一个颜色，那么在数组的运算符字段中记录的只是一个 8。 日期过滤器似乎也不起作用。不幸的是，我在 Excel 2016 中根本无法使用它 :( - 但您可以在 this answer by Emiel 中使用 自定义视图 找到有关建议解决方案的详细信息（注意：使用自定义视图将如果您的工作表上有任何ListObjects，则无法使用）。这很好，唯一的麻烦是它因为 ByRef 错误而不起作用。如果按照建议使用，即wksAF = Worksheets("Configuration")，则需要在函数定义Function SaveFilters(ByVal wks As Worksheet, FilterRange As String, FilterCache()) As Boolean中添加ByVal【参考方案3】：

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

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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      SaveListObjectFilters
' Purpose:  Save filter on worksheet
' Returns:  wks.AutoFilterMode when function entered
' Source: http://***.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://***.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

【讨论】：

这很好用，我会在保存函数的最后一个 End With 之前添加一个 .showalldata 以完全模仿非 listobject 版本！在 excel 2016 中为我工作，但我只使用“简单”过滤器进行了测试。 @PeterH 为什么 SaveListObjectFilters 是一个函数而不是一个子函数？谢谢！在我的 Excel 365 版本中工作。我爱你！【参考方案4】：

设置自定义视图对此非常有效。我收到一条消息，指出无法应用某些视图信息（Excel 2010），但检查过滤器，一切看起来都不错。根据具体情况，可能值得采用这种方法。感谢 Phil Spencer 的创意！

'[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]

【讨论】：

非常好的主意，但如果工作簿中只有一个表就行不通：techrepublic.com/blog/microsoft-office/…【参考方案5】：

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

我在 Reafidy 的原始代码中添加了数组功能，并调整了 restore 的整数变量来为我工作。

【讨论】：

'您的代码包含：ActiveSheet.AutoFilterMode = False Selection.AutoFilter 这是对 Reafidy 解决方案的改进，因为它还处理数组（即列上的多个过滤条件）。谢谢。

以上是关于在 Excel VBA 中，如何保存/恢复用户定义的过滤器？的主要内容，如果未能解决你的问题，请参考以下文章

单击保存按钮后如何在用户窗体中添加依赖于另一个组合框的excel vba组合框而不影响清除数据功能

Excel VBA中的ThisCell属性如何使用？

Excel VBA 临时保存值

使用 Excel VBA saveas 功能通过用户交互保存为 PDF

Excel VBA - 用户定义函数 - 可变大小参数

excel保存VBA问题及其解决方法