Excel 피벗 테이블 드릴다운에서 소스 시트를 필터링하는 방법은 무엇입니까?

Question

나는 Excel 스프레드시트에 지출을 기록한다. 두 번째 시트에는 비용을 월별, 범주별로 그룹화하여 총액을 확인할 수 있는 피벗 테이블이 있습니다. 셀을 두 번 클릭하면 선택한 월/범주에 대한 비용 목록을 표시하는 새 시트가 자동으로 추가됩니다. 새 시트에 비용 사본이 포함되어 있어 업데이트할 수 없다는 점을 제외하면 매우 좋습니다. 또한 드릴다운할 때마다 이러한 시트를 계속 삭제해야 하는데 이는 꽤 짜증나는 일입니다.

여기에서 추가된 시트의 이름을 자동으로 바꾸고 제거하는 방법을 설명하는 한 가지 예를 찾았습니다.http://www.contextures.com/excel-pivot-table-drilldown.html

제가 정말로 원하는 것은 첫 번째 시트로 다시 전환하고 그에 따라 필터를 업데이트하는 것입니다. 내가 어떻게 그것을 달성할 수 있는지 아는 사람이 있나요?

많은 감사를 드립니다.

패트릭

Answer 1

매우 간단하지는 않습니다. 코드를 다시 작성했습니다.엑셀의 일일 복용량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