1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
|
'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 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 |
Partager