In Excel VBA, come posso salvare / ripristinare un filtro definito dall’utente?

Come faccio a salvare e quindi riapplicare il filtro corrente usando VBA?

In Excel 2007 VBA, sto cercando di

  1. Salva qualsiasi filtro che l’utente ha nel foglio di lavoro corrente
  2. Cancella il filtro
  3. “Fare cose”
  4. Riapplica il filtro salvato

Sopra il codice non funziona in Excel 2010 in quanto ha più possibili tipi di filtro. Questo può essere vero anche per Excel 2007.

Excel 2010 (XL14) introduce una serie di modifiche su XL 2003 (XL11)

  • .Operator non è più True / False ma un’enumerazione. Esiste ancora un valore FALSE (= 0), che per qualche motivo non può essere impostato utilizzando Operatore: = quando si imposta Criteria1. I vecchi valori TRUE rimangono come xlAnd e xlOr (1 e 2).

  • Gli intervalli selezionati (xlTop10Items, xlBottom10Items, xlTop10Percent, xlBottom10Percent) sembrano essere implementati come un tipo .Operator = FALSE che otterrà il risultato desiderato nel momento in cui è stato impostato il filtro, ma con un Operatore diverso da zero. Tuttavia non è ansible utilizzare Operator: = quando si ripristina il filtro. Diventa un intervallo fisso piuttosto che (diciamo) nella top 10.

  • Per .Operator = xlFilterValues, .Criteria1 è una matrice dei valori selezionati e sembra essere ripristinata OK con l’istruzione prevista.

  • A quanto pare, i criteri per i filtri di formato (ad es. Celle con riempimento verde – novità XL 2010 oltre XL 2007?) Non possono essere ripristinati utilizzando i meccanismi .Criteria1. L’operatore può essere ripristinato, ma il filtro passa non viene ripristinato in modo da filtrare tutto. Meglio lasciarlo fuori.

Versione estesa di sopra, implementata come SaveFilters () e RestoreFilters ()

Ho usato numeri letterali piuttosto che le enumerazioni (xlAnd, xlOr ecc.) In modo che il codice abbia una possibilità di combattere per essere utilizzabile in XL 2003 che non aveva quelle enumerazioni. Alcune delle istruzioni CASE del ripristino sono codice ripetuto; questo è per semplificare le estensioni successive se qualcuno trova un modo per aggirare alcune delle limitazioni di cui sopra.

 ' 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 

Ho visto un suggerimento altrove per ottenere il risultato richiesto da

  • Configura una vista personalizzata (usando un nome improbabile per evitare di sovrascrivere le cose)

  • Esegui il codice con il filtro automatico distriggersto o modificato

  • . Mostra la vista (ripristina il layout precedente)

  • . Elimina la vista (per rimuovere i dati ridondanti).

Buona fortuna gente ..

Persone in cerca di salvataggio e ripristino di filtri listobject / tabella (testati in Office 2007).

Ho apportato alcune modifiche al codice molto buono sopra di Phil Spencer. Ora hai solo bisogno di aggiungere un listobject alla funzione e poi funziona anche per il salvataggio e il ripristino dei filtri 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 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 

L’impostazione di viste personalizzate funziona sorprendentemente bene per questo. Ricevo un messaggio per cui alcune informazioni sulla vista non possono essere applicate (Excel 2010) ma controllando i filtri, tutto sembra a posto. A seconda della situazione, potrebbe valere la pena di adottare questo approccio. Grazie a Phil Spencer per l’idea!

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

Ho aggiunto funzionalità di array al codice originale di Reafidy e ottimizzato la variabile intera del ripristino per funzionare correttamente.