在Excel VBA中，如何保存/恢复用户定义的过滤器？
如何使用VBA保存并重新应用当前过滤器 在Excel2007VBA中，我试图在Excel VBA中，如何保存/恢复用户定义的过滤器？,excel,vba,filter,Excel,Vba,Filter,如何使用VBA保存并重新应用当前过滤器 在Excel2007VBA中，我试图 保存用户在当前工作表上的任何筛选器 清除过滤器 “做事” 重新应用保存的筛选器 看看 为了防止链接腐烂，下面是代码（归功于原始作者）： 使用Excel 2010，只需删除标记的注释行 Sub ReDoAutoFilter() Dim w As Worksheet Dim filterArray() Dim currentFiltRange As String Dim col As Int
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
上述代码在Excel 2010中不起作用，因为它有更多可能的过滤器类型。Excel2007也是如此 Excel 2010（XL14）比XL 2003（XL11）引入了许多更改
- .运算符不再为True/False，而是枚举。仍然存在一个FALSE（=0）值，由于某些原因，无法在设置准则1时使用运算符：=设置该值。旧的真值保留为xlAnd和xlOr（1和2）
- 所选范围（xlTop10Items、xlBottom10Items、xlTop10Percent、xlBottom10Percent）似乎是以.Operator=FALSE类型实现的，该类型将在设置筛选器时获得所需的结果，但带有非零.Operator。但是，还原筛选器时不能使用运算符：=。它成为一个固定范围，而不是（比如）前10名
- 对于.Operator=xlFilterValues，.Criteria1是所选值的数组，似乎使用预期语句恢复为OK
- 格式过滤器的标准（例如，绿色填充的单元格-在XL 2010中新增，在XL 2007中新增？）显然无法使用.Criteria1机制恢复。运算符可以还原，但传递筛选器未还原，因此它会过滤掉所有内容。最好还是别说了
' 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
”用法示例：
“Dim Strafilterring As String”自动筛选范围
“Dim varFilterCache（）”自动筛选缓存
''[设置代码]
'Set wksAF=工作表（“配置”）
'
“”检查自动筛选，如果处于活动状态，请关闭。。
'SaveFilters wksAF、strAFilterRng、varFilterCache
“[过滤器关闭时的代码]
“[如果需要，设置特殊的自动过滤器]
“[过滤器打开时的代码（如适用）”
“”还原原始自动筛选（如果存在）。。
'恢复过滤器wksAF、strAFilterRng、varFilterCache
'~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Sub:SaveFilters
'目的：在工作表上保存筛选器
'输入函数时返回：wks.AutoFilterMode
'
"论据:
“[名称][类型][说明]
'筛选可能驻留在其上的wks I/P工作表
'过滤器作为字符串应用于的过滤器的O/P范围；”“如果没有过滤器
'过滤器缓存要保存过滤器的O/P变量动态数组
'
'作者：基于MS Excel自动筛选对象帮助文件
'
“修改：
'2006/12/11菲尔·斯宾塞：改编为通用程序
'2007/03/23 PJS:现在关闭。AutoFilterMode
'2013/03/13 PJS:XL14的初始mods，其运营商更多
'
评论:
'----------------------------
函数SaveFilters（wks作为工作表，FilterRange作为字符串，FilterCache（））作为布尔值
只要
FilterRange=“”无激活自动过滤器的替代信号
SaveFilters=wks.AutoFilterMode
如果保存过滤器，则
使用wks.AutoFilter
FilterRange=.Range.Address
使用。过滤器
重拨筛选器缓存（1到.计数，1到3）
对于ii=1到。计数
附.项目（ii）
如果，那么
#如果为False，则为'XL11代码
过滤器缓存（ii，1）=标准1
如果是的话，接线员
过滤器缓存（ii，2）=运算符
过滤器缓存（ii，3）=标准2
如果结束
#Else的第一个通行证XL14
选择Case.Operator
案例1，2'xlAnd，xlOr
过滤器缓存（ii，1）=标准1
过滤器缓存（ii，2）=运算符
过滤器缓存（ii，3）=标准2
案例0，3至7'无操作员，XLTOP10项目_
xlbottom10项目、xltop10百分比、xlbottom10百分比、xlFilterValues
过滤器缓存（ii，1）=标准1
过滤器缓存（ii，2）=运算符
Case Else“这些未正确恢复；标准1中有一些内容，但无法保存。
过滤器缓存（ii，2）=运算符
“FilterCache（ii，1）=.Criteria1”寻找保存和恢复listobject/表过滤器的人（在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
'~~~~~~~~~~~~~~~~~~~~~~~~~~~
'子：SaveListObjectFilters
'目的：在工作表上保存筛选器
'输入函数时返回：wks.AutoFilterMode
资料来源：http://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save- 还原用户定义的筛选器
'
"论据:
“[名称][类型][说明]
'筛选可能驻留在其上的wks I/P工作表
'过滤器作为字符串应用于的过滤器的O/P范围；”“如果没有过滤器
'过滤器缓存要保存过滤器的O/P变量动态数组
'
'作者：基于MS Excel自动筛选对象帮助文件
'
“修改：
'2006/12/11菲尔·斯宾塞：改编为通用电气
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
'[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]