Question

我试图用VBA实现AdvancedAutoFilter。这样很好。但是不幸的是，当更改文件中的某些内容时，取消选择了“自动筛选”。我使用ActiveSheet.ListObjects(1).Range.AutoFilter

修复了此问题

但是现在，每次我过滤和更改工作表中的某些内容时，都会忘记选择的过滤器，这很烦人。是否有解决此问题的方法？

亲切的问候

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Filters LagerlisteHW Row B for the word "Selfservice" and copys the corresponding lines
    ' to the sheet "Selfservice" to rows with the headers deefined in Selfservice!A2:C2
    ' Define the search-criteria in Selfservice!L1:L2 (currently the word "Selfservice")


    Sheets("LagerlisteHW").Range("B5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Selfservice").Range("L1:L2"), CopyToRange:=Sheets("Selfservice").Range("A2:C2"), Unique:=False


    If ActiveSheet.AutoFilterMode = False Then
        ActiveSheet.ListObjects(1).Range.AutoFilter
    End If



    'Selection.AutoFilter    ' Enable the AutoFilter Mode


End Sub

Answer 1

您必须存储自动过滤器，然后在运行高级过滤器后重新应用它。我使用了here中的代码并将其分为两个子代码。代码看起来像这样

Private Sub Worksheet_Change(ByVal Target As Range)
' Filters LagerlisteHW Row B for the word "Selfservice" and copys the corresponding lines
' to the sheet "Selfservice" to rows with the headers deefined in Selfservice!A2:C2
' Define the search-criteria in Selfservice!L1:L2 (currently the word "Selfservice")

Dim wks As Worksheet
Dim filterArray As Variant
Dim curFiltRange As String

    Set wks = Sheets("LagerlisteHW")
    StoreAutoFilter wks, filterArray, curFiltRange

    Sheets("LagerlisteHW").Range("B5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                                                    CriteriaRange:=Sheets("Selfservice").Range("L1:L2"), CopyToRange:=Sheets("Selfservice").Range("A2:C2"), Unique:=False


    If ActiveSheet.AutoFilterMode = False Then
        ActiveSheet.ListObjects(1).Range.AutoFilter
    End If

    RedoAutoFilter wks, filterArray, curFiltRange

    'Selection.AutoFilter    ' Enable the AutoFilter Mode

End Sub

Sub StoreAutoFilter(ByVal wks As Worksheet, ByRef filterArray As Variant, ByRef currentFiltRange As String)

    Dim col As Integer
    Dim f As Long

    ' Capture AutoFilter settings
    With wks.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

End Sub

Sub RedoAutoFilter(ByVal wks As Worksheet, ByVal filterArray As Variant, ByRef currentFiltRange As String)
Dim i As Long
Dim col As Integer

    ' Restore Filter settings
    For col = 1 To UBound(filterArray, 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                wks.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                wks.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col

End Sub

VBA Excel自动筛选使设置持久化

1 个答案: