Excel Pivot表 - 提取枢轴项目列表，并与半彩色串联

Question

我在图像中表示的枢轴表中具有数据。我的要求是为每个字段列表（A列）提取项目值（B列和C列）。将这些值存储在col C中通过半彩色（;）：

将多个值分开。

eg：对于每个HOD字段>即MGR1>从Col B（HOD ID字段）提取H12345和R12345;R12346来自Col C（Rep ID字段），并将这些值保存到以后在代码中使用的字符串。

等等MGR2，MGR3等...

我尝试了这样的事情，但不确定如何将值保存到字符串中，对不起，VB的新事物：

Sub PivotTabletest()
Dim PvtTbl As PivotTable
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Set PvtTbl = Worksheets("HOD View").PivotTables("PivotTable1")
Set rng1 = PvtTbl.PivotFields("REP ID").DataRange
Set rng2 = PvtTbl.PivotFields("HOD").PivotItems("MGR1").DataRange.EntireRow ' MGR1 should be picked dynamically instead
Set rng3 = Intersect(rng1, rng2)  
'Intersect(rng1, rng2).Interior.Color = vbYellow 'color coding works!

 For Each Cell In rng3
    Debug.Print Cell.Value
    Next Cell
End Sub

更新的代码，能够打印Col3的值，但需要能够制作" PivotItems（" MGR1"）" Dynamic（不是硬编码）

枢轴表

Answer 1

此功能将返回一个带有每个hod

的行的数组

Function PivotTableTest() AS Variant
    Dim PvtTbl As PivotTable, DataRng As Range, WorkingRow AS Range
    Dim Output() As String, ItemNumber AS Long
    Set PvtTbl = Worksheets("HOD View").PivotTables("PivotTable1")
    Set DataRng = PvtTbl.DataBodyRange
    'Resize the array, with a row for every entry in HOD ID
    Redim Output(0 To WorksheetFunction.CountA(PvtTbl.TableRange1.Columns(2)), 0 to 2)
    ItemNumber = 0
    'Loop down the rows
    For Each WorkingRow In DataRng.Rows
            'HOD in the first column
            If Len(WorkingRow.Cells(1,1).Offset(0,-2).Value) > 0 Then Output(ItemNumber, 0) = WorkingRow.Cells(1,1).Offset(0,-2).Value
            'HOD ID in the second column
            If Len(WorkingRow.Cells(1,1).Offset(0,-1).Value) > 0 Then Output(ItemNumber, 1) = WorkingRow.Cells(1,1).Offset(0,-1).Value
            'REP ID in the third column
            If Len(WorkingRow.Cells(1,1).Value) > 0 Then
                    Output(ItemNumber, 2) = Output(ItemNumber, 2) & IIF(Len(Output(ItemNumber, 2))>0,";","") & WorkingRow.Cells(1,1).Value
            Else
                    'Next Row
                    ItemNumber = ItemNumber+1
            End If
    Next WorkingRow
    'Remove any unused Rows from the array
    If ItemNumber > 0 Then Redim Preserve Output(0 to ItemNumber-1, 0 to 2)
    'Assign the Array to the Function output
    PivotTableTest = Output 
End Function