Как на VBA обойти лист Excel с группировками?

[VorkSH]

Как на VBA обойти иерархически лист Excel с группировками?
Понятно что это рекурсивно делать надо, но что-то никак не могу найти методы доступа к диапазону ячеек, который входит в группировку и определения принадлежности конкретной ячейки к какой-либо группе.

[mc-black]

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

К сообщению прикрепил пример того, каким я представляю себе файл с иерархией на основе группировки строк и в нем есть макрос, который демонстрирует, как можно получить уровень любой строки таблицы в иерархии, если строка подпадает под группировку. На основе уровня отступа и порядка следования элементов иерархии выстраивается алгоритм обхода. Тут для обхода достаточно простого цикла с анализом строк и динамическим массивом, имитирующим стек. Если на основе нижнего уровня надо просчитывать подитоги на разных уровнях, то цикл будет для каждого уровня группировки.

[VorkSH]

wsh.Rows(i).OutlineLevel - это как раз то что надо. Спасибо!

[mc-black]

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

Код: Выделить всё

Option Explicit

Sub Main()
    Dim wsh As Worksheet, i As Long, m As Long, j As Long, k As Long
    Dim MaxLevel As Long, CurLevel As Long, RowsArr() As Long, dLeft As Long
    
    Set wsh = ThisWorkbook.Worksheets(1)
    
    wsh.Outline.SummaryRow = xlSummaryAbove
    
    i = 3
    Do While Not wsh.Cells(i, 1).Value = Empty
        i = i + 1
    Loop
    MaxLevel = i - 3
    ReDim RowsArr(1 To MaxLevel) As Long
    
    m = wsh.UsedRange.Row + wsh.UsedRange.Rows.Count - 1
    i = 8
    Do While i <= m
        wsh.Cells(i, 3).Value = wsh.Rows(i).OutlineLevel
        i = i + 1
    Loop
    
    m = wsh.UsedRange.Row + wsh.UsedRange.Rows.Count - 1: i = 8
    j = 8: dLeft = 4
    Do While i <= m
        CurLevel = wsh.Rows(i).OutlineLevel
        RowsArr(CurLevel) = i
        If CurLevel = MaxLevel Then
            k = 1
            Do While k <= MaxLevel
                wsh.Cells(j, k + dLeft).Value = wsh.Cells(RowsArr(k), 1).Value
                k = k + 1
            Loop
            k = k - 1
            wsh.Cells(j, k + dLeft + 1).Value = wsh.Cells(RowsArr(k), 2).Value
            wsh.Cells(j, k + dLeft + 2).Value = wsh.Cells(RowsArr(k), 3).Value
            j = j + 1
        End If
        i = i + 1
    Loop
    
    Set wsh = Nothing
End Sub

[Dasist]

Вот это ты, брат, полезную вещь смастерил!
Респект!
Уважаю.