Получение дочерних элементов в PivotTable

[motorway]

Привет, кто может помочь с таким вопросом:
есть PivotTable (сводная таблица), в которую данные загружаются из PowerPivot (OLAP-источник). Как для выделенной ячейки можно получить список всех дочерних элементов (уровня leaf) в иерархии, которые соответствуют определенному полю?
Вот пример (на рисунке):
Ячейки, для которых нужно получить все непустые дочерние элементы, помечены красным, голубым и серым. Дочерние элементы, представляющие собой значения поля "код", выделены оранжевым. Их и нужно получать.
Для "Бразилия" и столбца "1" будет список 1,10,19,28, для столбца "2" - 2,11,20,29 и т.п. Для ячейки на пересечении "23.08.10" и столбца "1" дочерними будут только 1 и 10. Для общего итога - все: 1,2,3,10,11,12,19,20,21,28,29,30.
При этом, так как элементов может быть много, а получать их надо быстро, лучше не обращаться к самим ячейкам таблицы, так как обычно это медленно, а обращаться к объекту типа PivotCell. Похоже, надо копать в сторону PivotItems или подобной коллекции элементов, но как сделать точно - в этом и вопрос.

[KL (XL)]

Как-то так, но без самой таблицы как-то непривычно:

Sub Test()
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    
    Set pt = ActiveSheet.PivotTables(1)
    Set pf = pt.PivotFields(4)
    Set pi = pf.PivotItems(1)
    
    MsgBox pi.LabelRange(1).Value
End Sub

Если не дотянули, то еще есть объект pi.ChildItems(n)

[motorway]

Если везде поставить 1-й индекс, появляется ошибка 1004: невозможно получить свойство PivotItems класса PivotFields.
Также если менять индексы у PivotField, иногда появляется ошибка такого же рода о LabelRange у класса PivotItems
А свойство ChildItems для OLAP не работает! (http://msdn.microsoft.com/en-us/libr...hilditems.aspx)

[KL (XL)]

Сообщение от motorway

Если везде поставить 1-й индекс, появляется ошибка 1004: невозможно получить свойство PivotItems класса PivotFields.
Также если менять индексы у PivotField, иногда появляется ошибка такого же рода о LabelRange у класса PivotItems
А свойство ChildItems для OLAP не работает! (http://msdn.microsoft.com/en-us/libr...hilditems.aspx)

Индексы я ставил на глаз, вы же таблицу не выложили. Так что доводить вам ;-)

Кстати с первыми индексами - логично. У вас PivotField(1) - Акции даже не включен в таблицу, так откуда у него будут PivotItems?

[motorway]

Пока что получается, что вообще нерешаемая проблема - ChildItems-то не работает
И эту проблему я видел в Интернете - у многих она есть. Но решения пока не нашел
Кроме этого, у вас не используется текущая ячейка

[KL (XL)]

Сообщение от motorway

Пока что получается, что вообще нерешаемая проблема - ChildItems-то не работает
И эту проблему я видел в Интернете - у многих она есть. Но решения пока не нашел

Вы таблицу не хотите выложить? Думаю, искать недолго и обратите внимание на второй абзац, который я только что добавил к моему предыдущему посту.
Насчет текущей ячейки, я думал, вы сами разберетесь, там совсем легко, если найдем уровень объекта, на котором у вас эти значения
И нерешаемых задач не бывает, бывает недостачно информации или мотивации :-)

[motorway]

А будет ли она работать у вас без подключения к источнику?
OK, посмотрите, может, что получится
Понятно, что каким-то способом можно перебрать эти элементы, но хотелось бы это сделать максимально эффективно.
А мотивация большая

[KL (XL)]

Как-то так, хотя Union достаточно медленная функция. Но если значений не тысячи, то должно бегать быстро:

Option Explicit

Sub Test()
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItems
    Dim r As Range, a As Range
    Dim i As Long
    Dim arr
    
    Set pt = ActiveSheet.PivotTables(1)
    Set pf = pt.PivotFields(6)
    Set pi = pf.PivotItems
    
    For i = 1 To pi.Count
        If r Is Nothing Then Set r = pi(i).LabelRange Else Set r = Union(r, pi(i).LabelRange)
    Next i
    For Each a In r.Areas
        If Not Intersect(a, ActiveCell) Is Nothing Then
            arr = a.Value
            Exit For
        End If
    Next a
End Sub

[motorway]

Что-то пока не работает, пробую вывести значения, ничего не показывает, даже Msgbox не появляется. Как проверить полученные результаты?
Значений как раз может быть много в случае, если элемент достаточно высоко. При этом OLAP начинает тормозить, то же может быть и с макросом... Если >10000 ячеек, то в сводной таблице это уже не показывается
Еще есть один способ - получать текущий уровень вложенности элемента и идти вниз по элементам, пока их уровень вложенности будет больше значения для текущей ячейки.
Но надо еще определить их общее кол-во.

[KL (XL)]

Сообщение от motorway

Что-то пока не работает, пробую вывести значения, ничего не показывает, даже Msgbox не появляется. Как проверить полученные результаты?
Значений как раз может быть много в случае, если элемент достаточно высоко. При этом OLAP начинает тормозить, то же может быть и с макросом... Если >10000 ячеек, то в сводной таблице это уже не показывается

Все работает А вы разве не массив просили? Как же я вам его покажу?
- Кликните мышью перед E в строке End Sub
- Меню Debug > Run to cursor
- В окне Locals найдите + arr
- Кликните на плюс и изучайте значения массива

В каком виде вам нужен список?