Подтвердить что ты не робот

В Excel VBA, как мне сохранить/восстановить определяемый пользователем фильтр?

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

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

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

ОТВЕТЫ

Ответ 1

Посмотрите Зафиксировать состояние автофильтра

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

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

Ответ 2

Выше код не работает в 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 представляет собой массив выбранных значений и, кажется, будет восстановлен OK с ожидаемым выражением.

  • Критерии для фильтров формата (например, ячейки с зеленым заполнением - новые в 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 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

Я видел предложение в другом месте для достижения требуемого результата

  • Настройте пользовательский вид (используя какое-то невероятное имя, чтобы избежать перезаписи вещей)

  • Выполнить код с автофильтром выключен или изменен

  • .Посмотреть представление (восстановить предыдущий макет)

  • .Удалить представление (для удаления избыточных данных).

Удачи вам.

Ответ 3

Люди, которые ищут сохранение и восстановление фильтров listobject/table (тестируются в Office 2007).

Я внес некоторые изменения в очень хороший код выше Фила Спенсера. Теперь вам нужно только добавить 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 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

Ответ 4

Настройка пользовательских представлений работает на удивление хорошо. Я получаю сообщение о том, что некоторая информация о просмотре не может быть применена (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]

Ответ 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 Field " & f & " is an Array consisting of:"
                            Debug.Print "  " & CriteriaOne

                            filterArray(f, 2) = .Operator
                            Debug.Print "Field:" & f & " .Operator value is: " & .Operator
                            Debug.Print "  " & " (7 =xlFilterValues)"

                        ElseIf Not IsArray(.Criteria1) Then
                                   filterArray(f, 1) = .Criteria1
                                   Debug.Print "Field:" & f & " .Criteria1 is: " & .Criteria1

                                   If .Operator Then
                                       '2nd Dimension, 2nd column/index
                                        filterArray(f, 2) = .Operator
                                        Debug.Print "Field:" & f & " .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 & " .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 и изменил целочисленную переменную restore, чтобы работать для меня.

Ответ 6

Можете ли вы перейти к макросам записей и выполнить необходимые действия, а затем прекратить запись? Когда сделано - запустите макрос.

Например, простой фильтр:

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