Question

Как сохранить, а затем повторно применить текущий фильтр с помощью VBA?

В Excel 2007 VBA я пытаюсь

Сохраните любой фильтр, который есть у пользователя на текущем листе
Очистить фильтр
"Делай вещи"
Повторно применить сохраненный фильтр

Reafidy · Answer 1 · 29 февраля 2012

Посмотрите на Состояние автофильтра Capture

Чтобы предотвратить гниение ссылок, вот код (благодарность оригинальному автору):

Работает с 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

Phil Spencer · Answer 2 · 13 марта 2013

Приведенный выше код не работает в Excel 2010, так как в нем больше возможных типов фильтров. Это может быть верно и для Excel 2007.

В Excel 2010 (XL14) внесен ряд изменений по сравнению с XL 2003 (XL11)

. Оператор больше не True / False, а перечисление. По-прежнему существует значение FALSE (= 0), которое по какой-то причине нельзя установить с помощью Operator: = при настройке Criteria1. Старые значения TRUE остаются как xlAnd и xlOr (1 и 2).
Выбранные диапазоны (xlTop10Items, xlBottom10Items, xlTop10Percent, xlBottom10Percent) представляются реализованными как тип .Operator = FALSE, который будет достигать желаемого результата во время установки фильтра, но с ненулевым значением. Оператор. Однако вы не можете использовать 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

В других местах я видел предложение достичь желаемого результата к

Настроить пользовательский вид (используя какое-то невероятное имя, чтобы избежать перезаписи)
Выполнить код с отключенным или измененным автофильтром
. Показать представление (восстановить предыдущий макет)
. Удалить представление (для удаления избыточных данных).

Удачи, люди ..

PeterH · Answer 3 · 31 мая 2013

Люди, которые ищут сохранение и восстановление фильтров списочных объектов / таблиц (протестировано в Office 2007).

Я внес некоторые изменения в очень хороший код, приведенный выше, Фил Спенсер.Теперь вам нужно только добавить объект-список в функцию, и тогда он будет работать и для сохранения и восстановления фильтров-объектов:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sub:      SaveListObjectFilters
' Purpose:  Save filter on worksheet
' Returns:  wks.AutoFilterMode when function entered
' Source: /7930998/kak-sohranit-vosstanovit-polzovatelskii-filtr-v-excel-vba        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: /7930998/kak-sohranit-vosstanovit-polzovatelskii-filtr-v-excel-vbarestore-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

Cyious · Answer 4 · 23 июня 2015

Настройка пользовательских представлений работает на удивление хорошо для этого.Я получаю сообщение о том, что некоторая информация о просмотре не может быть применена (Excel 2010), но, проверяя фильтры, все выглядит хорошо.В зависимости от ситуации, возможно, стоит воспользоваться этим подходом.Спасибо Филу Спенсеру за идею!

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

vba_noob · Answer 5 · 28 мая 2015

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 и настроил целочисленную переменную восстановления, чтобы она работала для меня.

Как сохранить / восстановить пользовательский фильтр в Excel VBA?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 5 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Расширенная версия выше, реализованная как SaveFilters () и RestoreFilters ()

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как сохранить / восстановить пользовательский фильтр в Excel VBA?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 5 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Расширенная версия выше, реализованная как SaveFilters () и RestoreFilters ()

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов