Excel VBA에서 사용자 정의 필터를 저장/복원하려면 어떻게 해야 합니까?

Excel VBA에서 사용자 정의 필터를 저장/복원하려면 어떻게 해야 합니까?

VBA를 사용하여 현재 필터를 저장한 후 다시 적용하려면 어떻게 해야 합니까?

Excel 2007 VBA에서는

1. 현재 워크시트에 있는 모든 필터 저장
2. 필터를 클리어합니다.
3. "일하다"
4. 저장된 필터를 다시 적용합니다.

Capture Autofilter 상태를 확인합니다.

링크 부패를 방지하기 위해 코드(원저작자에게 크레딧)는 다음과 같습니다.

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

위의 코드는 Excel 2010에서는 사용할 수 없는 필터 타입이 많기 때문입니다.이는 Excel 2007에도 해당될 수 있습니다.

Excel 2010(XL14)은 XL 2003(XL11)에 비해 많은 변경을 도입하고 있습니다.

• 연산자는 더 이상 True/False가 아니라 열거형입니다.여전히 FALSE(=0) 값이 있으며, 어떤 이유로 기준 1을 설정할 때 연산자:=를 사용하여 이 값을 설정할 수 없습니다.이전 TRUE 값은 xlAnd 및 xlOr(1 및 2)로 유지됩니다.

• 선택한 범위(xlTop10Items, xlBottom10)항목 xlTop10Percent, xlBottom10Percent)는 로 구현되어 있는 것으로 보입니다.오퍼레이터=필터 설정 시 원하는 결과를 얻을 수 있지만 0이 아닌 FALSE 유형.교환입니다.그러나 필터를 복원할 때는 Operator:=를 사용할 수 없습니다.톱 10이 아니라 고정 범위가 됩니다.

• .Operator="filterValues"의 경우 .Criteria1은 선택한 값의 배열이며 예상된 문장과 함께 정상으로 복원된 것으로 보입니다.

• 형식 필터의 기준(녹색 채우기가 XL 2010 over XL 2007의 새로운 셀 등)은 를 사용하여 복원할 수 없는 것 같습니다.기준1 메커니즘연산자는 복원할 수 있지만 통과 필터는 복원되지 않으므로 모든 항목을 필터링합니다.그냥 꺼두는 게 낫겠어요.

SaveFilters() 및 RestoreFilters()로 구현된 위의 확장 버전

열거(xlAnd, xlOr 등)가 아닌 리터럴 번호를 사용하여 XL 2003에서 코드를 사용할 수 있도록 했습니다.이러한 열거는 없었습니다.restore 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

필요한 결과를 얻기 위한 제안을 다른 곳에서 본 적이 있습니다.

• 커스텀 뷰 설정(사물을 덮어쓰지 않기 위해 있을 것 같지 않은 이름을 사용)

• 자동 필터 꺼짐 또는 수정 시 코드 실행

• 보기 표시(이전 레이아웃 복원)

• 보기를 삭제합니다(용장 데이터를 제거하기 위해).

행운을 빌어요, 여러분..

리스트 오브젝트 / 테이블필터 저장 및 복원을 원하는 사용자(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'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

이 경우 커스텀뷰 설정은 놀라울 정도로 효과적입니다.몇 가지 뷰 정보를 적용할 수 없다는 메시지가 왔는데(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]

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의 원래 코드에 어레이 기능을 추가하고 복원을 위한 정수 변수를 조정했습니다.

언급URL : https://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter