Question

我有一个数据透视表，其中包含两个嵌入式行标签和一个数据变量（请参见下文）。考虑到Rowlabel1的特定枢纽项目，我想访问给定索引的Rowlabel2的枢纽项目。

这个问题（List excel pivot items of the second row field (multiple row fields) given a particular pivot item in the first row field）非常接近我的问题，但并非完全符合我的需求。我希望有一种方法可以获取项目而无需借助单独的子例程。

Rowlabel1 Rowlabel2 Value
a          A          1
           B          0
           C          3
b          D          2
           E          8
c          F          5

例如，我想获取Rowlabel1（“ E”）的第二项的Rowlabel2的第二项。物业 RowFields（“ Rowlabel2”）。PivotItems（2）.Caption

返回“ B”，而不是“ E”

Answer 1

Public Function getPiv(pt As PivotTable, iRowlabel1 As Integer, iRowlabel2 As Integer) As Variant

'returns item # iRowlabel2 of second Row field of item # iRowlabel1 of first Row field


Dim r As Range
Dim dr As PivotItem

'this captures your first entry in rowlabel1 - change as necessary
Set dr = pt.PivotFields("Rowlabel1").PivotItems(iRowlabel1)

'the macro won't work if the item is collapsed, so we set showDetail to true to expand it
If dr.ShowDetail = False Then
    dr.ShowDetail = True
End If

With dr
    'address what seems to be a bug(??) where if there are more than one data value columns,
    'the datarange appears to shift one row down
    If .DataRange.Columns.Count > 1 Then
        'here we shift back from the datarange to the 2nd column of the pivottable
        Set r = .DataRange.Offset(-1, -(.DataRange.Cells(1, 1).Column - 2))
    Else
        'here we shift back from the datarange to the 2nd column of the pivottable
        Set r = .DataRange.Offset(0, -(.DataRange.Cells(1, 1).Column - 2))
    End If
End With


getPiv = r.Cells(iRowlabel2, 1)


End Function

Answer 2

您可以遍历数据透视表的行PivotTable.PivotRowAxis.PivotLines。
他们的第一个左PivotLineCells包含RowField.PivotItems，可以对其进行比较和计数。

Private Sub GetIt()
    MsgBox GetPivotItem(ActiveSheet.PivotTables(1), 2, 2)
End Sub

Private Function GetPivotItem(ByRef pt As PivotTable, _
  ByRef index1 As Long, ByRef index2 As Long) As String
    Dim pl As PivotLine
    Dim counter1 As Long, counter2 As Long
    Dim remember1 As String, remember2 As String

    For Each pl In pt.PivotRowAxis.PivotLines
        If pl.LineType = xlPivotLineRegular Then
            If pl.PivotLineCells(1).PivotItem.Caption <> remember1 Then
                remember1 = pl.PivotLineCells(1).PivotItem.Caption
                remember2 = pl.PivotLineCells(2).PivotItem.Caption
                counter1 = counter1 + 1
                counter2 = 1
            ElseIf pl.PivotLineCells(2).PivotItem.Caption <> remember2 Then
                remember2 = pl.PivotLineCells(2).PivotItem.Caption
                counter2 = counter2 + 1
            End If
            If counter1 = index1 And counter2 = index2 Then
                GetPivotItem = pl.PivotLineCells(2).PivotItem.Caption
                Exit For
            End If
        End If
    Next pl
End Function

以上适用于带有单独列中的行字段的数据透视表布局（如您的屏幕截图PivotLine.PivotLineCells.Count > 1）。
如果您切换到具有在同一列中缩进的行字段的布局，请改用此格式：

Private Function GetPivotItemNew(ByRef pt As PivotTable, _
  ByRef index1 As Long, ByRef index2 As Long) As String
    Dim pl As PivotLine
    Dim counter1 As Long, counter2 As Long

    For Each pl In pt.PivotRowAxis.PivotLines
        If pl.LineType = xlPivotLineRegular Then
            If pl.PivotLineCells(1).PivotField = pt.RowFields(1) Then
                counter1 = counter1 + 1
                counter2 = 0
            End If
            If pl.PivotLineCells(1).PivotField = pt.RowFields(2) Then counter2 = counter2 + 1
            If counter1 = index1 And counter2 = index2 Then
                GetPivotItemNew = pl.PivotLineCells(1).PivotItem.Caption
                Exit For
            End If
        End If
    Next pl
End Function

给定第一行字段中的特定枢轴项，获取第二行字段中的给定枢轴项

2 个答案: