Excelピボットテーブルのドリルダウンでソースシートをフィルタリングする方法


5

私は自分の経費をExcelスプレッドシートに記録します。 2番目のシートでは、支出を月ごとおよびカテゴリごとにグループ化して合計を表示できるようにするピボットテーブルがあります。セルをダブルクリックすると、新しいシートが自動的に追加され、選択した月/カテゴリの費用のリストが表示されます。新しいシートに経費のコピーが含まれているので、それを更新することはできません。また、ドリルダウンするたびにこれらのシートを削除し続ける必要があり、これはかなり面倒です。

追加したシートの名前を自動的に変更して削除する方法を説明する例を1つ見つけました。 http://www.contextures.com/excel-pivot-table-drilldown.html

私が本当に欲しいのは最初のシートに戻ってそれに応じてフィルタを更新することです。誰かが私がそれを達成する方法を知っていますか?

どうもありがとう、

パトリック


それはVBAですることは可能ですが、私は一般的な解決策を持っていない - あなたはこのような他のいくつかのビジネスインテリジェンスツールを使用することを検討しましたか? QlikView
Aprillion

1
より良い解決策は、MS Accessに切り替えて、ドリルダウンできるレポートを作成することです。レポートを見終わったら、単にそれを閉じて、もう一度開くと、新しいデータがあなたを待っています。
wbeard52

私はVBAソリューションを望んでいました。私はQlikViewを見ていました、かっこいい、個人版は無料です、私はそれを試してみるかもしれません。
Patrick J Collins

私はAccessのライセンスを持っていませんが、おそらくそれは検討に値する道です、ありがとう。
Patrick J Collins

私はこれをStackOverflowに移すことを提案しました。誰もまだここに答えを投稿しておらず、あなたの質問はVBAについてです。多分あなたはそこにもっと運があるでしょう。
Excellll

回答:


1

非常に簡単ではありません。からコードを再構築しました エクセルの毎日の投与量 ピボットでデータポイントを選択してマクロを実行すると、ソースデータ内の一致する行が表示されます。そのためには、[詳細の表示]機能を使用してから、データと一致するように各列にフィルタを作成します。

新しい右クリックボタンに設定するか、デフォルトの詳細表示動作を上書きすることができます。

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

私はあなたの解決策をExcel Mac 2011を使って一周しましたが、うまくいかなかったのです。私がコメントアウトしたことをサポートしていなかったいくつかのメソッドがありました、しかしそれから私がマクロを実行しようとしたときにそれはちょうど "400"でポップアップを表示しました。ああ。私はまだWindowsでこれを試していません。
Patrick J Collins

1
それは私にとってはWindows 7 Pro SP1、Excel 2010 32ビットでうまく機能しています。
nutsch
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.