如何过滤Excel数据透视表中的源表钻取？

Question

我在 Excel 电子表格中记录了我的开支。在第二张表中，我有一个数据透视表，允许我按月和按类别对费用进行分组以查看总数。如果我双击一个单元格，会自动添加一个新工作表，显示所选月份/类别的费用列表。太好了，只是新表包含费用的副本，因此我无法更新它们。此外，每次我向下钻取时，我都必须不断删除这些工作表，这很烦人。

我在这里找到了一个解释如何自动重命名和删除添加的工作表的示例：http : //www.contextures.com/excel-pivot-table-drilldown.html

我真正想要的是切换回第一个工作表并相应地更新过滤器。有谁知道我如何实现这一目标？

非常感谢，

帕特里克

Answer 1

不是非常简单。我已经从每日的 Excel 中重建了代码，以利用 Excel 2010 更好的过滤选项。如果您在数据透视表中选择一个数据点并运行宏，它将为您提供源数据中的匹配行。它通过使用“显示详细信息”函数，然后为每列创建一个过滤器以匹配数据来实现此目的。

\n\n

您可以在新的右键单击按钮上设置它，或覆盖默认的显示详细信息行为。

\n\n

Private mPivotTable As PivotTable\n\nSub GetDetailsOnSource()\n\n\'turn off updates to speed up code execution\nWith Application\n    .ScreenUpdating = False\n    .EnableEvents = False\n    .Calculation = xlCalculationManual\nEnd With\n\n    On Error Resume Next\n        Set mPivotTable = Selection.PivotTable\n    On Error GoTo 0\n\n\n   If Not mPivotTable Is Nothing Then\n        If mPivotTable.PivotCache.SourceType <> xlDatabase Or _\n            Intersect(Selection, mPivotTable.DataBodyRange) Is Nothing Then\n\n            Set mPivotTable = Nothing\n        End If\n    End If\n\n   Selection.ShowDetail = True\n   GetDetailInfo\n\nWith Application\n    .ScreenUpdating = True\n    .EnableEvents = True\n    .Calculation = xlCalculationAutomatic\nEnd With\n\nEnd Sub\n\n\nSub GetDetailInfo()\n\n    Dim rCell As Range\n    Dim rData As Range\n    Dim vMin As Variant, vMax As Variant\n    Dim rSource As Range\n    Dim lOldCalc As Long, sh As Worksheet\n    Dim colItems As Collection, arrFilter As Variant, lLoop As Long, lLastRow As Long\n    Dim bBlanks As Boolean, bNumbers As Boolean, sNumberFormat As String\n\n   Set sh = ActiveSheet\n\n    If Not mPivotTable Is Nothing Then\n\n        lOldCalc = Application.Calculation\n        Application.Calculation = xlCalculationManual\n\n        Set rSource = Application.Evaluate(Application.ConvertFormula(mPivotTable.SourceData, xlR1C1, xlA1))\n        rSource.Parent.AutoFilterMode = False\n        rSource.AutoFilter\n\n       lLastRow = sh.ListObjects(1).Range.Rows.Count\n       sh.ListObjects(1).Unlist\n\n        \'Loop through the header row\n\n       For Each rCell In Intersect(sh.UsedRange, sh.Rows(1)).Cells\n\n            If Not IsDataField(rCell) Then\n                If Application.WorksheetFunction.CountIf(rCell.Resize(lLastRow), "") > 0 Then bBlanks = True Else bBlanks = False\n\n                rCell.Resize(lLastRow).RemoveDuplicates Columns:=1, Header:=xlYes\n\n                If Application.WorksheetFunction.CountA(rCell.EntireColumn) = Application.WorksheetFunction.Count(rCell.EntireColumn) + 1 _\n                    And Not IsDate(sh.Cells(Rows.Count, rCell.Column).End(xlUp)) Then \'convert numbers to text\n                    bNumbers = True\n                    rCell.EntireColumn.NumberFormat = "0"\n                    rCell.EntireColumn.TextToColumns Destination:=rCell, DataType:=xlFixedWidth, _\n                        OtherChar:="" & Chr(10) & "", FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True\n                Else\n                    bNumbers = False\n                End If\n\n                arrFilter = sh.Range(rCell.Offset(1), sh.Cells(sh.Rows.Count, rCell.Column).End(xlUp).Offset(IIf(bBlanks, 1, 0))).Value\n\n\n                If Application.WorksheetFunction.Subtotal(3, rCell.EntireColumn) = 1 Then\n                    rSource.AutoFilter Field:=rCell.Column, Criteria1:=""\n\n                Else:\n                    arrFilter = Application.Transpose(arrFilter)\n\n                    sNumberFormat = rSource.Cells(2, rCell.Column).NumberFormat\n\n                    If bNumbers Then _\n                        rSource.Columns(rCell.Column).NumberFormat = "0"\n\n                    rSource.AutoFilter Field:=rCell.Column, Criteria1:=arrFilter, Operator:=xlFilterValues\n\n                    rSource.Cells(2, rCell.Column).NumberFormat = sNumberFormat\n                End If\n\n                Set arrFilter = Nothing\n            End If\n\n        Next rCell\n\n        \'so it doesn\xe2\x80\x99t run at next sheet activate\n       Set mPivotTable = Nothing\n\n        Application.Calculation = lOldCalc\n\n        \'Delete the sheet created by double click\n       Application.DisplayAlerts = False\n            sh.Delete\n        Application.DisplayAlerts = True\n\n        rSource.Parent.Activate\n\n    End If\nEnd Sub\n\nPrivate Function IsDataField(rCell As Range) As Boolean\n\n    Dim bDataField As Boolean\n    Dim i As Long\n\n    bDataField = False\n    For i = 1 To mPivotTable.DataFields.Count\n        If rCell.Value = mPivotTable.DataFields(i).SourceName Then\n            bDataField = True\n            Exit For\n        End If\n    Next i\n\n    IsDataField = bDataField\n\nEnd Function\n

\n