保存自动过滤器设置并重新应用

Question

我有两个Excel表，一个现有的宏复制其中一个表（表A）中的数据并将其粘贴到另一个表的底部（表B）。我发现如果表A被过滤，这个宏将无法工作，因为它表示它无法从过滤表中复制数据。我想修改我现有的宏，以便它首先复制任何过滤器（当我运行宏时，可以过滤任何，全部或没有我的列），然后删除它们，然后运行我以前编程的活动，然后重新应用保存的过滤器，然后给我一杯啤酒。不过，我很乐意为此做一些让我喝啤酒的事情。

我认为这是一个常见的问题，所以我搜索了一些代码，我可以将它放在现有代码的开头和结尾。我发现了以下内容，但是当我将其添加到现有代码并运行宏时，我在早期行上得到一个错误：“currentFiltRange = .Range.Address”错误状态，“对象变量或带块变量没有设置”。我对VBA很新，不知道我复制的以下代码有什么问题。

Sub CopyThisWeekToRollupAndFilter()


    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer

    Set w = ActiveWorkbook.Sheets("Weekly")

    ' 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

' Add my existing 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

Answer 1

如果你在谈论表格，它们不是过滤范围，它们是ListObjects，你可以用以下方式调用它们的范围

currentFiltRange = ActiveWorkbook.Sheets("Weekly").ListObjects("Table1").Range.Address

这是一个链接，提供表格的VBA指南：https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

以下是您正在尝试的示例的链接：https://www.get-digital-help.com/2012/09/26/copy-excel-table-filter-criteria-vba/

Answer 2

我希望有一个比这更好的答案，但如果你没有发现任何有用的东西，它可能会有所帮助。预设过滤器将保持不变：

Sub Hide_Unhide()
    Dim HiddenColumn() As Long
    Dim HiddenRow() As Long
    Dim colCounter As Long, rowCounter As Long, arrColLength As Long, arrRowLength As Long
    arrColLength = 0
    arrRowLength = 0

    Application.ScreenUpdating = False

    'Unhide columns
    For colCounter = 1 To ActiveSheet.UsedRange.Columns.Count
        If Columns(colCounter).Hidden = True Then
            arrColLength = arrColLength + 1
            ReDim Preserve HiddenColumn(1 To arrColLength)
            HiddenColumn(arrColLength) = colCounter
            Columns(colCounter).Hidden = False
        End If
    Next colCounter

    'Unhide rows
    For rowCounter = 1 To ActiveSheet.UsedRange.Rows.Count
        If Rows(rowCounter).Hidden = True Then
            arrRowLength = arrRowLength + 1
            ReDim Preserve HiddenRow(1 To arrRowLength)
            HiddenRow(arrRowLength) = rowCounter
            Rows(rowCounter).Hidden = False
        End If
    Next rowCounter

    'Your code here


    'apply hiddend columns
    For colCounter = 1 To arrColLength
        Columns(HiddenColumn(colCounter)).Hidden = True
    Next colCounter

    'apply hiddend rows
    For rowCounter = 1 To arrRowLength
        Rows(HiddenRow(rowCounter)).Hidden = True
    Next rowCounter

    Application.ScreenUpdating = True

End Sub

Answer 3

如果没有打开AutoFilter，那么w.AutoFilter将是Nothing

您应该在代码中添加一个检查，以便首先查看是否启用了过滤

EG

isFiltered = Not w.AutoFilter Is Nothing

所以你可以跳过捕获/重新应用设置

编辑：这样的事情：

Sub CopyThisWeekToRollupAndFilter()


    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer, isFiltered As Boolean

    Set w = ActiveWorkbook.Sheets("Weekly")
    isFiltered = Not w.AutoFilter Is Nothing 

    If isFiltered Then
    ' 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

    End If  'was filtered


' Add my existing code here'

    If isFiltered Then
    ' 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 If 'was filtered


End Sub