如何创建数据透视表值的动态链接?

时间:2016-02-26 19:36:53

标签: excel vba pivot-table

tab1我有一个数据透视表。当我在256上双击小计号pivot table时,会弹出一个新的工作表,其中包含详细信息。一切都如预期的那样。

tab2上,我在字段A1中有一个公式。此公式引用数据透视表中的小计值(来自tab1)

=GETPIVOTDATA("theId",tab1!$A$1) 

A1显示256。 。 。与数据透视表中的完全相同。

我需要能够点击此A1字段并查看包含详细信息的弹出工作表(就像我点击数据透视表一样)

问题是GETPIVOTDATA仅返回一个值而没有链接或间接引用

我该怎么做?

2 个答案:

答案 0 :(得分:1)

对不起延迟,但是周末还在中间。 那么这里是我如何显示数据从枢轴显示的答案,只需在单元格内单击,在另一个具有GETPIVOTDATA公式的工作表中。

请注意,在我的数据透视表中,我设置为“重复所有项目标签”并使用旧式数据透视表。

看图片: 重复所有商品标签 enter image description here

旧样式对我来说效果更好,最重要的是宏(VBA) enter image description here

话虽如此,我们的代码!!

所有这些都在常规模块中。

Sub getDataFromFormula(theFormulaSht As Worksheet, formulaCell As Range)
    Dim f
    Dim arrayF
    Dim i
    Dim L
    Dim iC
    Dim newArrayF() As Variant
'    Dim rowLables_Sort()
'    Dim rowLables_Sort_i()
    Dim T As Worksheet
    Dim rowRange_Labels As Range
    Dim shtPivot As Worksheet
    Dim shtPivotName
    Dim thePivot As PivotTable
    Dim numRows
    Dim numCols
    Dim colRowRange As Range
    Dim colRowSubRange As Range
    Dim First As Boolean
    Dim nR
    Dim nC
    Dim myCol
    Dim myRow
    Dim theRNG As Range

    Set T = theFormulaSht 'the sheet where the formula is

    '#####################################
    'my example formula
    '=GETPIVOTDATA("EURO",P!$A$3,"Descripcion","Ingresos Netos de Terceros ,","Mes","July","CuentaCrest","310100","Descripción Crest","Net revenue third parties","Producto","AFR","SubProducto","AFRI","TM1","Net Revenue")
    '#####################################

    T.Activate 'go!
    f = formulaCell.Formula 'get the formula
    f = Replace(f, "=GETPIVOTDATA", "") 'delete some things...
    f = Replace(f, Chr(34), "")
    f = Replace(f, ",,", ",") 'in my data, there is ,, and I need to fix this...
    f = Right(f, Len(f) - 1) 'take the formual without parentesis.
    f = Left(f, Len(f) - 1)

    '####################################
    'Restult inside "f"
    'EURO,P!$A$3,Descripcion,Ingresos Netos de Terceros ,Mes,July,CuentaCrest,310100,Descripción Crest,Net revenue third parties,Producto,AFR,SubProducto,AFRI,TM1,Net Revenue
    '####################################

    arrayF = Split(f, ",")

    '####################################
    'Restult inside arrayF
    'EURO,P!$A$3,Descripcion,Ingresos Netos de Terceros ,Mes,July,CuentaCrest,310100,Descripción Crest,Net revenue third parties,Producto,AFR,SubProducto,AFRI,TM1,Net Revenue
    '####################################

    shtPivotName = arrayF(1) 'set (just) the name of the sheet with the pivot
    shtPivotName = Left(shtPivotName, InStr(1, shtPivotName, "!") - 1)
    Set shtPivot = Sheets(shtPivotName) 'set the var with the sheet that contents the pivot
    Set thePivot = shtPivot.PivotTables(1) 'store the pivot inside

    If shtPivot.Visible = False Then 'if the sheet with the pivot is hidden... set visible.
        shtPivot.Visible = xlSheetVisible
    End If

    shtPivot.Activate 'go there!

    numRows = thePivot.RowRange.Rows.Count - 1 'the number of rows of the row Range
    numCols = thePivot.RowRange.Columns.Count 'here the columns of the same range
    Set rowRange_Labels = thePivot.RowRange.Resize(1, numCols)
    'with Resize get jus the labels above the RowRange (see the picture (1))

    iC = -1

    First = True

    For Each i In rowRange_Labels 'run the labels
        iC = -1 'set the counter
        If First Then 'check the flag to see if is the firt time...
            First = False 'set the flag to FALSE to go the other part of the IF next time
            Set colRowRange = Range(Cells(i.Row, i.Column), Cells(i.Row + numRows - 1, i.Column))
            Do
                iC = iC + 1 'just to set the counter
            Loop While arrayF(iC) <> i.Value 'stop when gets equals and keep the counter

            'in the array the values are just strings,
            'but we know that is key-value pairs thats why adding +1 to iC we get the real info
            'below the label
            nR = colRowRange.Find(arrayF(iC + 1)).Row 'just used here
            nC = WorksheetFunction.CountIf(colRowRange, arrayF(iC + 1)) + nR - 1 'here we count to set the range
            Set colRowSubRange = Range(Cells(nR, i.Column), Cells(nC, i.Column)) 'set the range
            myRow = colRowSubRange.Row 'here we get the row of the value
        Else
            Do 'this is simpler
                iC = iC + 1
            Loop While arrayF(iC) <> i.Value 'againg...

            nR = colRowSubRange.Offset(, 1).Find(arrayF(iC + 1)).Row 'use the SubRange to get others subranges
            nC = WorksheetFunction.CountIf(colRowSubRange.Offset(, 1), arrayF(iC + 1)) + nR - 1
            Set colRowSubRange = Range(Cells(nR, i.Column), Cells(nC, i.Column))
            myRow = colRowSubRange.Row 'idem
        End If
    Next i


    numCols = thePivot.DataBodyRange.Columns.Count 'other part of the pivot... (see the picture (2))
    Set theRNG = thePivot.DataBodyRange.Resize(1, numCols) 'just take the above labels
    Set theRNG = theRNG.Offset(-1, 0)
    iC = -1

        For Each L In thePivot.ColumnFields 'for every label...
            Do
                iC = iC + 1
            Loop While L <> arrayF(iC) 'idem
            myCol = theRNG.Find(arrayF(iC + 1), , , xlWhole).Column
            'always will be just one column...
        Next L
    Cells(myRow, myCol).ShowDetail = True 'here is the magic!!! show all the data
End Sub

在工作表代码中:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Left(Target.Formula, 13) = "=GETPIVOTDATA" Then 'Check if there a formula GetPivotData
        getDataFromFormula Sheets(Me.Name), Target
    End If
End Sub

看到这张图片,了解公式发生了什么:

enter image description here

将公式拆分为f,然后转换为arrayF

我确信您需要做一些更改,但这是非常实用和基本的,并且很容易找到您需要的内容。

另外:

这部分代码帮助我理解了支点的作用。使用相同的数据和数据透视表,我运行了代码:

Sub rangePivot()
    Dim Pivot As PivotTable
    Dim rng As Range
    Dim P As Worksheet
    Dim D As Worksheet
    Dim S As Worksheet
    Dim i
    Set P = Sheets("P") 'the sheet with the pivot
    Set D = Sheets("D") 'the sheet with the data
    Set S = Sheets("S") 'the sheet with the cells with the formula
    S.Activate 'go
    Set Pivot = P.PivotTables("PivotTable1") 'store the pivot here...

    For i = 1 To Pivot.RowFields.Count
        Cells(i, 1).Value = Pivot.RowFields(i)
    Next i
    For i = 1 To Pivot.ColumnFields.Count
        Cells(i, 2).Value = Pivot.ColumnFields(i)
    Next i
    For i = 1 To Pivot.DataFields.Count
        Cells(i, 3).Value = Pivot.DataFields(i)
    Next i
    For i = 1 To Pivot.DataLabelRange.Count
        Cells(i, 4).Value = Pivot.DataLabelRange.Address(i)
    Next i
    For i = 1 To Pivot.DataLabelRange.Count
        Cells(i, 4).Value = Pivot.DataLabelRange.Address(i)
    Next i
    For i = 1 To Pivot.DataFields.Count
        Cells(i, 5).Value = Pivot.DataFields(i)
    Next i
    For i = 1 To Pivot.DataFields.Count
        Cells(i, 5).Value = Pivot.DataFields(i)
    Next i
    For i = 1 To Pivot.DataFields.Count
        Cells(i, 5).Value = Pivot.DataFields(i)
    Next i
    For i = 1 To Pivot.DataBodyRange.Count
        Cells(i, 6).Value = Pivot.DataBodyRange.Address(i)
    Next i
    For i = 1 To Pivot.DataLabelRange.Count
        Cells(i, 7).Value = Pivot.DataLabelRange.Address(i)
    Next i
    Cells(1, 8).Value = Pivot.ColumnGrand
    Cells(1, 9).Value = Pivot.RowRange.Address
    Cells(1, 11).Value = Pivot.TableRange1.Address
    Cells(1, 12).Value = Pivot.TableRange2.Address
End Sub

而且,和往常一样,如果你需要帮助&amp;改进与我联系。希望这也有其他帮助。

答案 1 :(得分:0)

如果你想做VBA,你可以设置一个像这样的事件:

http://www.ozgrid.com/forum/showthread.php?t=49050

完成设置后,您需要开发一些代码来确定小计单元格的位置(因为这些代码很容易发生变化)。拥有该地址后,您可以使用Range([subtotal]).ShowDetail = True