Макрос обработки прайсов из 1С

Sub Price1C()
    On Error Resume Next
    Const EMPTY_COLUMN& = 8 ' указываем здесь номер пустого столбца
    Const NAME_COLUMN& = 2 ' указываем здесь номер столбца с НАЗВАНИЯМИ товаров
    Const ART_COLUMN& = 3 ' указываем здесь номер столбца с АРТИКУЛОМ
    Const PRICE_COLUMN& = 4 ' указываем здесь номер столбца с ЦЕНОЙ товара
    
    ' © 2019 ExcelVBA.ru
    ' excelvba.ru/programmes/Unification/manuals/config/macro/price_1C
    Dim ra As Range, cell As Range, arr, i&, res, txt$, TYPE_COLUMN&, HasChildren As Boolean
    Dim section$, art$, title$, title_level&, current_value$
    Set ra = Range(Cells(2, NAME_COLUMN&), Cells(Rows.Count, NAME_COLUMN&).End(xlUp))
    arr = ra.Resize(, 2).Value ' массив размером (кол-во строк ; 2)
    TYPE_COLUMN& = EMPTY_COLUMN& + 1
 
    Application.ScreenUpdating = False
    For Each cell In ra.Cells
        i& = i& + 1
        arr(i&, 1) = cell.EntireRow.OutlineLevel
        arr(i&, 2) = IIf(cell.Font.Bold, "заголовок", "данные")
        cell.EntireRow.Cells(ART_COLUMN&) = "'" & cell.EntireRow.Cells(ART_COLUMN&).Text
    Next cell
    ' выводим массив с уровнями группировки строк в пустой столбец
    Cells(2, EMPTY_COLUMN&).Resize(UBound(arr), 2).Value = arr
 
    ' выводим заголовки дополнительных столбцов
    With Cells(1, EMPTY_COLUMN&).Resize(, 8)
        .Value = Array("Группировка", "Тип строки", "Тип данных", "Артикул", "Название", "Опция", "Цена", "Подраздел")
        .Font.Bold = True: .Interior.Color = vbGreen
    End With
 
    ' считываем данные в массив для быстрой обработки
    arr = Range(Range("a2"), Cells(Rows.Count, NAME_COLUMN&).End(xlUp).Offset(1)).Resize(, EMPTY_COLUMN& + 1).Value
    ReDim res(1 To UBound(arr), 1 To 6)  ' массив для результатов
    
    For i = LBound(arr) To UBound(arr) - 1 ' перебираем все строки прайс-листа
        
        If (arr(i, TYPE_COLUMN&) = "данные") And (Trim(arr(i, NAME_COLUMN&)) <> "") Then
 
            ' проверяем, есть ли вложенные опции (уровень группировки больше на 1)
            HasChildren = Val(arr(i + 1, EMPTY_COLUMN&)) = Val(arr(i, EMPTY_COLUMN&)) + 1
 
            If HasChildren And (arr(i + 1, TYPE_COLUMN&) = "данные") Then
                ' только запоминаем название товара
                title$ = Application.Trim(arr(i, NAME_COLUMN&))
                title_level& = Val(arr(i, EMPTY_COLUMN&))
            Else
                ' выводим данные по товару в доп столбцы
                art$ = Application.Trim(arr(i, ART_COLUMN&))
                current_value$ = Application.Trim(arr(i, NAME_COLUMN&))
                res(i, 2) = "'" & art$
                res(i, 5) = arr(i, PRICE_COLUMN&)
                res(i, 6) = section$
 
                If Val(arr(i, EMPTY_COLUMN&)) = title_level& + 1 Then
                    ' строка с опцией товара
                    res(i, 1) = "опция"
                    res(i, 3) = title$
                    If res(i, 3) Like art$ & " *" Then res(i, 3) = Mid(res(i, 3), Len(art$) + 2)
                    res(i, 4) = current_value$
 
                Else
                    ' строка с товаром без опций
                    res(i, 1) = "товар"
                    res(i, 3) = current_value$
                    If res(i, 3) Like art$ & " *" Then res(i, 3) = Mid(res(i, 3), Len(art$) + 2)
                    res(i, 4) = ""
                    title$ = "": title_level& = 0
                End If
            End If
 
        Else ' строка заголовка
            section$ = Application.Trim(arr(i, NAME_COLUMN&))
            title$ = "": title_level& = 0
        End If
 
    Next i
 
    ' выводим массив с результатами в пустые столбцы справа
    Cells(2, EMPTY_COLUMN& + 2).Resize(UBound(res), 6).Value = res
 
    With Cells(1, EMPTY_COLUMN&).Resize(, 8)
        .EntireColumn.AutoFit:     .WrapText = True
        .Resize(, 4).EntireColumn.HorizontalAlignment = xlCenter
    End With
    Application.ScreenUpdating = True
End Sub