Как отфильтровать исходный лист в сводной таблице Excel?

Question

Я записываю свои расходы в таблицу Excel. На втором листе у меня есть сводная таблица, которая позволяет мне группировать мои расходы по месяцам и по категориям, чтобы увидеть итоги. Если дважды щелкнуть ячейку, автоматически добавляется новый лист, в котором отображается список расходов за выбранный месяц / категорию. Это довольно здорово, за исключением того, что на новом листе есть копия расходов, поэтому я не могу их обновить. Кроме того, я должен продолжать удалять эти листы каждый раз, когда выполняю детализацию, что довольно раздражает.

Я нашел один пример, который объясняет, как автоматически переименовывать и удалять добавленные листы здесь: http://www.contextures.com/excel-pivot-table-drilldown.html

Что мне действительно нужно, так это вернуться на первый лист и соответствующим образом обновить фильтры. Кто-нибудь знает, как мне этого добиться?

Большое спасибо,

Патрик

Answer 1

Не очень просто. Я пересобрал код из ежедневной дозы Excel, чтобы воспользоваться лучшими возможностями фильтрации Excel 2010. Если вы выберете точку данных в своей сводной области и запустите макрос, он даст вам совпадающие строки в ваших исходных данных. Это делается с помощью функции «Показать подробности», а затем создается фильтр для каждого столбца в соответствии с данными.

Вы можете установить его на новую кнопку, щелкнув правой кнопкой мыши, или перезаписать стандартное поведение отображения деталей.

Private mPivotTable As PivotTable

Sub GetDetailsOnSource()

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

    On Error Resume Next
        Set mPivotTable = Selection.PivotTable
    On Error GoTo 0


   If Not mPivotTable Is Nothing Then
        If mPivotTable.PivotCache.SourceType <> xlDatabase Or _
            Intersect(Selection, mPivotTable.DataBodyRange) Is Nothing Then

            Set mPivotTable = Nothing
        End If
    End If

   Selection.ShowDetail = True
   GetDetailInfo

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub


Sub GetDetailInfo()

    Dim rCell As Range
    Dim rData As Range
    Dim vMin As Variant, vMax As Variant
    Dim rSource As Range
    Dim lOldCalc As Long, sh As Worksheet
    Dim colItems As Collection, arrFilter As Variant, lLoop As Long, lLastRow As Long
    Dim bBlanks As Boolean, bNumbers As Boolean, sNumberFormat As String

   Set sh = ActiveSheet

    If Not mPivotTable Is Nothing Then

        lOldCalc = Application.Calculation
        Application.Calculation = xlCalculationManual

        Set rSource = Application.Evaluate(Application.ConvertFormula(mPivotTable.SourceData, xlR1C1, xlA1))
        rSource.Parent.AutoFilterMode = False
        rSource.AutoFilter

       lLastRow = sh.ListObjects(1).Range.Rows.Count
       sh.ListObjects(1).Unlist

        'Loop through the header row

       For Each rCell In Intersect(sh.UsedRange, sh.Rows(1)).Cells

            If Not IsDataField(rCell) Then
                If Application.WorksheetFunction.CountIf(rCell.Resize(lLastRow), "") > 0 Then bBlanks = True Else bBlanks = False

                rCell.Resize(lLastRow).RemoveDuplicates Columns:=1, Header:=xlYes

                If Application.WorksheetFunction.CountA(rCell.EntireColumn) = Application.WorksheetFunction.Count(rCell.EntireColumn) + 1 _
                    And Not IsDate(sh.Cells(Rows.Count, rCell.Column).End(xlUp)) Then 'convert numbers to text
                    bNumbers = True
                    rCell.EntireColumn.NumberFormat = "0"
                    rCell.EntireColumn.TextToColumns Destination:=rCell, DataType:=xlFixedWidth, _
                        OtherChar:="" & Chr(10) & "", FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True
                Else
                    bNumbers = False
                End If

                arrFilter = sh.Range(rCell.Offset(1), sh.Cells(sh.Rows.Count, rCell.Column).End(xlUp).Offset(IIf(bBlanks, 1, 0))).Value


                If Application.WorksheetFunction.Subtotal(3, rCell.EntireColumn) = 1 Then
                    rSource.AutoFilter Field:=rCell.Column, Criteria1:=""

                Else:
                    arrFilter = Application.Transpose(arrFilter)

                    sNumberFormat = rSource.Cells(2, rCell.Column).NumberFormat

                    If bNumbers Then _
                        rSource.Columns(rCell.Column).NumberFormat = "0"

                    rSource.AutoFilter Field:=rCell.Column, Criteria1:=arrFilter, Operator:=xlFilterValues

                    rSource.Cells(2, rCell.Column).NumberFormat = sNumberFormat
                End If

                Set arrFilter = Nothing
            End If

        Next rCell

        'so it doesn’t run at next sheet activate
       Set mPivotTable = Nothing

        Application.Calculation = lOldCalc

        'Delete the sheet created by double click
       Application.DisplayAlerts = False
            sh.Delete
        Application.DisplayAlerts = True

        rSource.Parent.Activate

    End If
End Sub

Private Function IsDataField(rCell As Range) As Boolean

    Dim bDataField As Boolean
    Dim i As Long

    bDataField = False
    For i = 1 To mPivotTable.DataFields.Count
        If rCell.Value = mPivotTable.DataFields(i).SourceName Then
            bDataField = True
            Exit For
        End If
    Next i

    IsDataField = bDataField

End Function