在数据透视表中覆盖双击操作以转到过滤的源数据

我正在尝试创build一个数据透视表，其中双击一个值将用户引导到具有此值所代表的行的过滤源表单，而不是具有基础数据的新表单。

这是我得到了多less，但我有问题提取相关的行和列的名称/值，以及当前在透视表中活动的filter。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim rng As Range Dim wks As Worksheet Dim pt As PivotTable ' Based on http://stackoverflow.com/questions/12526638/how-can-you-control-what-happens-when-you-double-click-a-pivot-table-entry-in-ex Set wks = Target.Worksheet For Each pt In wks.PivotTables() Set rng = Range(pt.TableRange1.Address) If Not Intersect(Target, rng) Is Nothing Then Cancel = True End If Next ' Source: http://www.mrexcel.com/forum/excel-questions/778468-modify-pivottable-double-click-behavior.html On Error GoTo ExitNow With Target.PivotCell If .PivotCellType = xlPivotCellValue And _ .PivotTable.PivotCache.SourceType = xlDatabase Then SourceTable = .PivotTable.SourceData MsgBox SourceTable ' I found the sourcetable, how would I collect the row/column ' names and values in order to filter this table? End If End With ExitNow: Exit Sub End Sub 

为了过滤源表单，我需要在双击时提取以下特征：

• 在当前数据透视表中激活的filter（原始**'Fieldname'和相关的filter）
• 与被选中的聚合相关的原始**标题和行名称和值（例如FieldX = 2013，FieldY =“X”），这将使我能够过滤源表单并显示基础行。

**请注意，我不确定这是否相关，但是我广泛遇到数据透视表，其中显示的行名称与源数据表中的数据透视表不同（通过在数据透视表中手动重命名）。 另外，是否有可能提取在数据透视表中创build的“分组”？

使用这些特征，用于定位源数据和应用相关filter的VBA应该是相对简单的。 在大多数情况下，源表是一个“Excel表”，如果这是相关的。

任何帮助是极大的赞赏。

Answer 1

对此的解决scheme很大程度上取决于您使用的filter。 数据PivotFilters器的定义方式与定义自动PivotFilters器的方式不同。 这意味着您将需要为每种types的filter进行翻译。

AutoFilters在Criteria1完成所有的魔法，而PivotFilters有一个FilterType和Value1来使其工作。 这是翻译步骤。

对于简单的平等，这是相当容易的，这是代码包括在下面。 它解决了如何find列标题和设置filter的问题。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim pt As PivotTable Dim wks As Worksheet Set wks = Target.Worksheet For Each pt In wks.PivotTables() If Not Intersect(Target, pt.TableRange1) Is Nothing Then Cancel = True End If Next If Cancel <> True Then Exit Sub End If Set pt = Target.PivotCell.PivotTable Dim rng As Range Set rng = Application.Range(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1)) Dim sht_rng As Worksheet Set sht_rng = rng.Parent sht_rng.AutoFilterMode = False Dim pf As PivotField For Each pf In pt.PivotFields Dim pfil As PivotFilter For Each pfil In pf.PivotFilters If pfil.FilterType = xlCaptionEquals Then rng.AutoFilter Field:=Application.Match(pf.SourceName, rng.Rows(1), 0), Criteria1:=pfil.Value1 End If Next pfil Next pf sht_rng.Activate rng.Cells(1, 1).Select End Sub 

一对笔记：

• 我正在使用PivotTable.SourceData来获取涉及单元格的范围。 这将在R1C1表示法中返回一个值，所以我使用Application.ConvertFormula将其转换为A1表示法。 然后我需要使用Application.Range来查找这个string。 （由于此代码在特定Worksheet范围内执行，因此您需要在此处添加Application ，以便扩展search的范围）
• 之后，遍历所有的PivotFields和它们的PivotFilters是一个简单的问题。
• 在那个循环中，你需要find列标题（在标题行中使用Application.Match ： .Rows(1) ）并添加filter。 这是需要转换步骤的地方。 您可以为每个支持的filtertypesSelect... Case一个Select... Case 。
• 如果任何一个字段是一个filter而不是一个行/列，你可能还想检查CurrentPage 。
• 最后，有可能是手动filter，而不是我正在迭代的标签filter。 你可以通过PivotItems循环检查Visible是否需要这些。

希望这个代码能让你开始，但也暗示了所涉及任务的复杂性。 您可能希望限制自己支持特定types的filter。

枢轴和数据的图片

数据透视表与filter

所有数据

过滤的数据

Answer 2

用Byron的回答提出的片段，我提出了以下几点。 它不适用于分组列，也不适用于表格。 现在，至less我可以使用常规范围和数据透视表来处理源数据。

我使用下面的代码来调用第二个过程，注意（到目前为止）我不是VBA的专家; 我只是想在我正在处理的电子表格中使用这个function：

 Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) Application.ScreenUpdating = False Dim pt As PivotTable Dim wks As Worksheet Set wks = target.Worksheet ' Find out if we selected a pivottable, cancel default behaviour For Each pt In wks.PivotTables() If Not Intersect(target, pt.TableRange1) Is Nothing Then Cancel = True End If Next If Cancel <> True Then Exit Sub End If Call pivot_filter_source(target) Application.ScreenUpdating = True End Sub 

而被调用的程序：

 Public Sub pivot_filter_source(target As Range) 'Dim target As Range 'Set target = Sheets("Pivot").Range("E11") Dim pt As PivotTable Dim wks As Worksheet Set wks = target.Worksheet ' Derive PivotTable Set pt = target.PivotCell.PivotTable Dim rng As Range ' Define the source data Set rng = Application.Range(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1)) ' TODO: Make it work with Excel Tables Dim pf As PivotField Dim pi As PivotItem Dim page_filters As Collection Set page_filters = New Collection Dim list As Variant ' Loop over page filters and add their values to array For Each pf In pt.PageFields Debug.Print "Filter field: " & pf.SourceName For Each pi In pf.PivotItems ' Find out if filter contains filtered items If pi.Visible Then Debug.Print "... filter: " & pi.Value If Contains(page_filters, pf.SourceName) Then list = page_filters.Item(pf.Name) ReDim Preserve list(UBound(list) + 1) filter_value = pi.Value If pi.Value = "(blank)" Then filter_value = "=" End If list(UBound(list)) = filter_value page_filters.Remove (pf.SourceName) page_filters.Add list, pf.SourceName Else list = Array(pf.SourceName, pi.Value) page_filters.Add list, pf.SourceName Set list = Nothing End If End If Next pi Next pf Set rng = Application.Range(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1)) rng.Parent.Activate On Error Resume Next ActiveSheet.ShowAllData ' Loop over the extracted filters, apply Dim source_column_name As String Dim fieldname As String Dim filter_values As Variant For Each source_column In page_filters ' Handle '(blank)' values For i = 0 To UBound(source_column) - 1 If source_column(i) = "(blank)" Then source_column(i) = "=" Next fieldname = source_column(0) filter_values = source_column Call filter_range(rng, fieldname, filter_values) Next ' Loop over columns of interest For Each pi In target.PivotCell.ColumnItems Debug.Print pi.Parent.SourceName & " ==> " & pi.SourceName filter_values = Array(pi.SourceName) If pi.SourceName = "(blank)" Then filter_values = Array("=") Call filter_range(rng, pi.Parent.SourceName, filter_values) Next ' Loop over rows of interest For Each pi In target.PivotCell.RowItems Debug.Print pi.Parent.SourceName & " ==> " & pi.SourceName filter_values = Array(pi.SourceName) If pi.SourceName = "(blank)" Then filter_values = Array("=") End If Call filter_range(rng, pi.Parent.SourceName, filter_values) Next rng.Parent.Activate End Sub Public Sub filter_range(rng As Range, field_name As String, filter_values As Variant) rng.AutoFilter _ Field:=Application.Match(field_name, rng.Rows(1), 0), _ Criteria1:=filter_values, _ Operator:=xlFilterValues End Sub Public Function Contains(col As Collection, key As Variant) As Boolean Dim obj As Variant On Error GoTo err Contains = True obj = col(key) Exit Function err: Contains = False End Function 

Answer 3

非常感谢这个线程。 我不知道为什么微软从来没有提供过这个function。 当您在Pivots中检查数据时，您通常需要直接清理源数据。 你的想法是在源数据上单独应用数据透视表结构和filter，但是你也可以应用以下简单的技巧：要过滤源列表，我一直使用高级filter。 双击枢轴后，将创build一个新工作表。 这包含一个结果列表，该列表将成为源数据上的高级filter的过滤条件。 由于高级filter允许多个AND（按列）和OR（按行）条件，应始终正确过滤源列表。 我通常将filter范围限制在显示源表中唯一loggingID的第一列，这样，我的过滤列表始终是正确的百位数。 高级filter的一个缺点是它会删除源列表头中的自动filter。 这就是为什么你的上述解决scheme更聪明;-)