获取特定单元格的数据透视字段的值

Question

我有一个来自 ssas 连接的数据透视表。表中使用了几个数据透视字段。对于此示例，假设它们是大小、颜色和位置。我的目标是编写一些 vba，在其中传递单元格范围并获取相应枢轴字段的值。

例如，如果我传递B6 的单元格范围，我想知道该单元格来自位置2，颜色2 为size1。如果我通过B8 范围，我会得到 location1、Color3、Size1 等。

到目前为止，这是我能做的。我可以获得该单元格的公式值。这是 B6 的结果：GETPIVOTDATA("[Measures].[myValues]",$A$1,"[d size].[size]","[d size].[size].&[Size1]","[d color].[color]","[d color].[color].&[Color2]","[d location].[location]","[d location].[location].&[location2]") 使用此代码：

Function xxx(ByVal xyz As Range) As Variant
  xxx = xyz.Formula
End Function
Sub blah()
  MsgBox (xxx(ActiveWorkbook.Sheets("Sheet1").Range("D13")))
End Sub

我还可以遍历数据透视字段并获取它们的名称，（但我不知道如何获取它们的值）[Measures].[myValues]、[d size].[size] 等...使用此代码：

With Worksheets("Sheet1").PivotTables(1)
    For i = 1 To .PivotFields.Count
        MsgBox .PivotFields(i).Name
    Next
End With

我现在的问题是，如何获取特定单元格的这些数据透视字段的值。我希望能够发送B6 并返回，或者可以访问：location2、Color2、Size1

编辑：

越来越近...我现在可以遍历每个字段并获取它们的名称和值，例如 [d size].[size]&[Size1] 等，但现在我希望能够仅获取 Size1 或 [Size1] 的值：

Sub Test()
  Dim iRange As Variant
  iRange = ActiveCell.Address
  FieldPicker (iRange)
End Sub

Function FieldPicker(targetCell As Variant) As Variant
  With Range(targetCell).PivotCell
      For i = 1 To .RowItems.Count
          MsgBox .RowItems(i).SourceName
      Next
  End With
End Function

Answer 1

改编自 RoryA 的回答：http://www.mrexcel.com/forum/excel-questions/332678-pivottable-problem.html

'Given a pivottable value cell and a category name, return the category value
'Note: you would need morte code to account for a "page" category 
Function PivotCategoryValue(rngInput As Range, fldName As String) As String

   Dim pc As PivotCell
   Dim pf As PivotField, pi As PivotItem
   Dim rv As String

   On Error Resume Next
   Set pc = rngInput.PivotCell
   On Error GoTo err_handle

   If pc Is Nothing Then
      rv = "Not a pivot cell"
   Else
      Select Case pc.PivotCellType
         Case xlPivotCellValue
            If pc.RowItems.Count Then
               For Each pi In pc.RowItems
                  If pi.Parent.Name = fldName Then
                    rv = pi.Value
                    GoTo done
                  End If
               Next pi
            End If
            If pc.ColumnItems.Count Then
               For Each pi In pc.ColumnItems
                  If pi.Parent.Name = fldName Then
                    rv = pi.Value
                    GoTo done
                  End If
               Next pi
            End If
         Case Else
            rv = "Not a pivot data cell"
      End Select
   End If
done:
   PivotCategoryValue = rv
Exit Function

err_handle:
   PivotCategoryValue = "Unknown error"
End Function