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

如何保存并使用VBA重新应用当前的filter？

在Excel 2007 VBA中，我试图

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

Answer 1

看看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 col End Sub 

Answer 2

以上代码在Excel 2010中不起作用，因为它具有更多可能的filtertypes。 Excel 2007也可能是这样。

Excel 2010（XL14）对XL 2003（XL11）进行了一些更改

• 操作员不再是真/假，而是一个枚举。 仍有一个FALSE（= 0）值，出于某种原因，在设置Criteria1时，不能使用Operator：=进行设置。 旧的TRUE值仍然是xlAnd和xlOr（1和2）。

• 所select的范围（xlTop10Items，xlBottom10Items，xlTop10Percent，xlBottom10Percent）似乎被实现为.Operator = FALSEtypes，它将在设置filter时获得所需的结果，但是具有非零的.Operator。 但是，在恢复filter时，不能使用Operator：=。 它成为一个固定的范围，而不是（比方说）前10名。

• 对于.Operator = xlFilterValues，.Criteria1是所选值的数组，并且似乎用预期的语句还原了OK。

• 格式过滤条件的标准（例如，使用绿色填充的单元格 – XL 2010中的新增functionXL？）显然无法使用.Criteria1机制进行恢复。 操作员可以恢复，但通过filter不恢复，所以它过滤掉所有的东西。 最好不要离开。

以上的扩展版本实现为SaveFilters（）和RestoreFilters（）

我已经使用了文字数字而不是枚举（xlAnd，xlOr等），这样代码就有了在XL 2​​003中没有这些枚举的战斗机会。 某些恢复CASE语句是重复的代码; 这是为了简化后面的扩展，如果有人find一种方法来绕过上面的一些限制。

 ' 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 

我在别处看到了一个build议来达到所要求的结果

• 设置自定义视图（使用一些不可能的名称来避免覆盖事物）

• 用自动filterclosures或修改执行代码

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

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

祝你好运。

Answer 3

正在寻找保存和恢复列表对象/表格筛选器的人员（在Office 2007中进行了testing）。

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

 '~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 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 PH: 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 PH: 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 

Answer 4

设置自定义视图的效果非常好。 我收到一条消息，指出某些视图信息无法应用（Excel 2010），但是检查filter，一切都看起来不错。 根据情况，可能值得采取这种方法。 感谢菲尔·斯宾塞的想法！

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

Answer 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的原始代码添加了数组function，并调整了恢复的整数variables来为我工作。

Answer 6

你可以去macroslogging和执行所需的行动，然后停止录制？ 完成后运行macros。

例如简单的filter：

 Sub Macro1() Cells.Select Selection.AutoFilter ActiveSheet.Range("$A$1:$G$1").AutoFilter Field:=1, Criteria1:="=*test*", _ Operator:=xlAnd End Sub