Поиск подмножества поля строки сводной таблицы

Я пытаюсь использовать VBA для извлечения и обработки данных из сводной таблицы. В моей сводной таблице есть три метки строк (D_Campaign, D_TL, D_Agent_Name).

С использованием

For Each pt1 In pt.RowFields("D_Agent_Name").PivotItems
    Debug.Print pt1.Name
Next pt1

Я могу получить список всех ярлыков в «D_Agent_Name». Однако мне бы хотелось получить список меток в «D_Agent_Name» для заданного значения «D_TL». Может кто-то указать мне верное направление?


excel pivot-table vba
person Michael    schedule 16.08.2012    source источник
comment
Может быть проще извлечь данные из исходных данных сводной таблицы.   -  person danielpiestrak    schedule 16.08.2012

Ответы (2)


arrow_upward
0
arrow_downward

Я думаю, что @gimp может быть прав в том, что с исходными данными проще иметь дело, но вот что мне подходит:

Sub PrintTLValues(AgentName As String)
Dim pt As Excel.PivotTable
Dim rfTL As Excel.PivotField
Dim rfAN As Excel.PivotField
Dim cell As Excel.Range

Set pt = ThisWorkbook.Worksheets(1).PivotTables(1)
Set rfAN = pt.RowFields("D_Agent_Name")
Set rfTL = pt.RowFields("D_TL")
For Each cell In Intersect(pt.DataBodyRange.EntireRow, rfAN.DataRange)
    If cell.Value = AgentName Then
        Debug.Print Intersect(cell.EntireRow, rfTL.DataRange).Value
    End If
Next cell
End Sub

Назовите это так:

GetTLValues "Michael"

Мне нравится программировать сводные таблицы, и мой опыт показывает, что обычно существует более одного способа ободрать кота сводной таблицы :). Очень полезный справочник по программированию диапазонов сводной таблицы можно найти на сайте Джона Пельтье.

person Doug Glancy    schedule 16.08.2012
comment
Спасибо Дуг, не совсем то, что я хотел, но очень близко. Между вашим кодом и кодом Джона Пельтье я в конце концов добился своего. Ваше здоровье. - person Michael; 17.08.2012

arrow_upward
0
arrow_downward

Добрался туда в конце концов после того, как Дуг указал мне правильное направление.

Sub ptSelect()
    ' Select intersect of pivot table and output cell values to debug window
    Dim pt As PivotTable
    Dim ptSel As Range

    Set pt = Worksheets("Pivot Table").PivotTables("PT Sales Data")
    Set ptSel = Intersect(pt.PivotFields("D_Campaign").PivotItems("Acquisition").DataRange.EntireRow, pt.PivotFields("D_TL").DataRange)

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

Одна вещь, которую я заметил, заключается в том, что для этого требуется, чтобы сводная таблица была в классическом формате, она не будет работать с компактным форматом в 2007 году.

person Michael    schedule 17.08.2012