Excel: копирование выбранных элементов из фильтра

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