为了账号安全,请及时绑定邮箱和手机立即绑定

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

/ 猿问

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

杨魅力 2019-07-30 17:43:31

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

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

在Excel 2007 VBA中,我正在尝试

  1. 保存用户在当前工作表上的任何过滤器

  2. 清除过滤器

  3. “做东西”

  4. 重新应用已保存的过滤器


查看完整描述

3 回答

?
倚天杖

看看Capture Autofilter状态

为了防止链接腐烂,这里是代码(原作者的信用):

使用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 colEnd Sub


查看完整回答
反对 回复 2019-07-30
?
青春有我


上面的代码在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。但是,在恢复过滤器时,您无法使用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

我已经看到其他地方的建议,以达到所需的结果

  • 设置自定义视图(使用一些不太可能的名称以避免覆盖事物)

  • 关闭或修改自动过滤器执行代码

  • 。显示视图(恢复以前的布局)

  • 。删除视图(删除冗余数据)。

祝你好运...


查看完整回答
反对 回复 2019-07-30
?
尚方宝剑之说

人们正在寻找保存和恢复listobject / table过滤器(在Office 2007中测试)。

我对Phil Spencer的上述代码做了一些修改。现在,您只需要向该函数添加一个listobject,然后它也可用于保存和恢复listobject过滤器:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~

' 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


查看完整回答
反对 回复 2019-07-30
  • 3 回答
  • 0 关注
  • 366 浏览
我要回答

添加回答

回复

举报

0/150
提交
取消
意见反馈 帮助中心 APP下载
官方微信