vba - 覆盖数据透视表中的双击操作以转到筛选的源数据

Question

我正在尝试创建一个数据透视表，其中双击一个值将用户引导到过滤后的源工作表，其中包含该值所代表的行，而不是一个包含基础数据的新工作表。

这就是我已经取得的进展，但我在提取相关行和列名称/值以及数据透视表中当前处于事件状态的过滤器时遇到问题。

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

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

当前数据透视表中事件的过滤器(原始**“字段名”和相关过滤器)

与所选聚合相关的原始**标题和行名称和值(例如，FieldX = 2013, FieldY="X")，这将使我能够过滤源工作表并显示基础行。

** 请注意，我不确定这是否相关，但我广泛地偶然发现了数据透视表，其中显示的行名称与源数据表中的行名称不同(通过在数据透视表中手动重命名它们)。此外，是否可以提取在数据透视表中创建的“分组”？

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

任何帮助是极大的赞赏。

Answer 1

解决方案很大程度上取决于您使用的过滤器。 PivotFilters 的方式定义与定义自动筛选器的方式不同。这意味着您需要为每种类型的过滤器进行翻译。

自动过滤器在 Criteria1 中发挥了所有作用。而 PivotFilters有一个FilterType和 Value1让它工作。这是翻译步骤。

对于简单的相等，这相当容易，这就是下面包含的代码。它解决了如何查找列标题和设置过滤器的问题。

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查找此字符串。 (由于此代码在特定 Worksheet 的范围内执行，您需要在此处添加 Application 以扩大搜索范围)

之后，遍历所有 PivotFields 及其 PivotFilters 就很简单了。

在该循环中，您需要找到列标题(在标题行中使用 Application.Match: .Rows(1) )并添加过滤器。这是需要转换步骤的地方。你可以做一个Select... Case对于每种支持的过滤器类型。

您可能还想查看 CurrentPage如果任何字段是过滤器而不是行/列。

最后，可能会有手动过滤器而不是我正在迭代的标签过滤器。您可以循环浏览PivotItems并检查 Visible如果你想要那些。

希望这段代码可以帮助您入门，但也暗示了所涉及任务的复杂性。您可能希望限制自己支持特定类型的过滤器。

Pivot 和数据图片

带有过滤器的数据透视表



所有数据



过滤数据