Question

我在Excel文件中（数据透视表中）有一个过滤器，并且我选择了很多要过滤的项目。

我需要进行报告并列出过滤器中所有已选择的项目。但是，我不想手动输入每个选定项的名称。

有没有一种方法可以简单地将所选项目复制到过滤器中并将其粘贴到其他位置？

Answer 1

以下VBA子例程会将给定工作表的自动筛选器的选择条件导出到工作簿中的新工作表：

Public Sub ExportFilter(ByRef ws As Worksheet)
Dim hsFilter As Worksheet
    Dim rFilter As Range, rHeader As Range, rCell As Range, lFilter As Long, lMin As Long, lMax As Long, lStep As Long
    Dim bFilterOn As Boolean, lFilterOperator As Long, vFilterCriteria1 As Variant, vFilterCriteria2 As Variant
    On Error Resume Next
    If Not (ws.AutoFilterMode) Then Exit Sub
    Set rFilter = ws.AutoFilter.Range
    If rFilter Is Nothing Then Exit Sub
    Set rHeader = rFilter.Rows(2)

    If hsFilter Is Nothing Then
        With ActiveSheet
            Set hsFilter = ThisWorkbook.Worksheets.Add
            'hsFilter.Visible = xlSheetVeryHidden
            .Activate
        End With
    Else
         hsFilter.Rows.Delete
    End If

    For Each rCell In rHeader.Cells
        lFilter = 1 + rCell.Column - rHeader.Cells(1, 1).Column

        bFilterOn = ws.AutoFilter.Filters(lFilter).On
        hsFilter.Cells(1, lFilter).Value = bFilterOn

        If bFilterOn Then
            lFilterOperator = ws.AutoFilter.Filters(lFilter).Operator
            hsFilter.Cells(2, lFilter).Value = lFilterOperator

            If lFilterOperator = xlFilterValues Then '7
                vFilterCriteria1 = ws.AutoFilter.Filters(lFilter).Criteria1
                Set vFilterCriteria2 = Nothing
                lMin = LBound(vFilterCriteria1)
                lMax = UBound(vFilterCriteria1)
                For lStep = lMin To lMax
                    hsFilter.Cells(3 + lStep, lFilter).NumberFormat = "@"
                    vFilterCriteria2 = vFilterCriteria1(lStep)
                    If Len(CStr(vFilterCriteria2)) > 1 And Left(CStr(vFilterCriteria2), 1) = "=" Then
                        vFilterCriteria2 = Mid(vFilterCriteria2, 2, Len(vFilterCriteria2) - 1)
                    End If
                    hsFilter.Cells(3 + lStep - lMin, lFilter).Value = vFilterCriteria2
                Next lStep
            ElseIf (lFilterOperator = 0) Or (lFilterOperator = xlTop10Items) Or (lFilterOperator = xlTop10Percent) Or (lFilterOperator = xlFilterDynamic) Then  'One Filter
                vFilterCriteria1 = ws.AutoFilter.Filters(lFilter).Criteria1
                Set vFilterCriteria2 = Nothing
                hsFilter.Cells(3, lFilter).NumberFormat = "@"
                If Len(CStr(vFilterCriteria1)) > 1 And Left(CStr(vFilterCriteria1), 1) = "=" Then
                    vFilterCriteria1 = Mid(vFilterCriteria1, 2, Len(vFilterCriteria1) - 1)
                End If
                hsFilter.Cells(3, lFilter).Value = vFilterCriteria1
            Else
                vFilterCriteria1 = ws.AutoFilter.Filters(lFilter).Criteria1
                vFilterCriteria2 = ws.AutoFilter.Filters(lFilter).Criteria2
                hsFilter.Cells(3, lFilter).NumberFormat = "@"
                If Len(CStr(vFilterCriteria1)) > 1 And Left(CStr(vFilterCriteria1), 1) = "=" Then
                    vFilterCriteria1 = Mid(vFilterCriteria1, 2, Len(vFilterCriteria1) - 1)
                End If
                hsFilter.Cells(3, lFilter).Value = vFilterCriteria1
                hsFilter.Cells(4, lFilter).NumberFormat = "@"
                If Len(CStr(vFilterCriteria2)) > 1 And Left(CStr(vFilterCriteria2), 1) = "=" Then
                    vFilterCriteria2 = Mid(vFilterCriteria2, 2, Len(vFilterCriteria2) - 1)
                End If
                hsFilter.Cells(4, lFilter).Value = vFilterCriteria2
            End If
        End If
    Next rCell

    Set rFilter = Nothing
    Set rHeader = Nothing
    Set vFilterCriteria1 = Nothing
    Set vFilterCriteria2 = Nothing
End Sub

Answer 2

您可以按条件使用高级过滤器，也可以使用“复制到”选项。数据-高级（在“排序和过滤器”部分）

https://support.office.com/en-us/article/filter-by-using-advanced-criteria-4c9222fe-8529-4cd7-a898-3f16abdff32b?NS=EXCEL&Version=90&SysLcid=1033&UiLcid=1033&AppVer=ZXL900&HelpId=21102&ui=en-US&rs=en-US&ad=US

Excel：从筛选器复制选定的项目

2 个答案: