Сводная таблица Excel - Извлечение списка сводных элементов и объединение с точкой с запятой - PullRequest
Новая
       6

Сводная таблица Excel - Извлечение списка сводных элементов и объединение с точкой с запятой

0 голосов
/ 12 марта 2019

У меня есть данные в сводной таблице, как показано на рисунке.Мое требование состоит в том, чтобы извлечь значения элементов (столбцы B и C) для каждого списка полей (столбец A).Сохраните эти значения в строку и разделите несколько значений в столбце C точкой с запятой (;):

Например: для каждого поля HOD> т.е. MGR1> извлечь H12345 из Col B (поле HOD ID) и R12345;R12346 из Col C (REP ID Field) и сохраните эти значения в строках для последующего использования в коде.

и т. Д. С 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")" динамический (не жестко запрограммированный)

сводная таблица

1 Ответ

0 голосов
/ 13 марта 2019

Эта функция будет возвращать массив со строкой для каждого 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
...