Макросы для вставки строки заголовка при начале новой группы

Я пытаюсь создать новый код, который будет копировать и вставлять столбец заголовка (из строки 1 данных) в список при каждом изменении группы данных. Размер каждой группы различен, и размеры меняются от одного месяца к следующему. Для дополнительного усложнения названия групп могут меняться. Например, мне нужен код, чтобы разбить список на что-то вроде этого:

Header
Corporate
Corporate
Corporate
Insert header
Financial
Financial
Insert header
Public 
etc

Данные должны оставаться на одном листе, поэтому нет необходимости перемещать данные куда-либо

До сих пор я думал о чем-то вроде этого, но не знаю правильный синтаксис для использования, чтобы сделать это работоспособным:

Do forever
‘stop at the end
   If group_cellvalue(vArraycounter) = “” then leave
   Endif
vArraycounter = vArraycounter + 1
   ‘test the current group against that in the previous row if different, insert 
   'header
   If group_cellvalue((vArraycounter) <> group_cellvalue((vArraycounter - 1 ) 
    then
        InsertRow
        InsertHeadingText
        'Increment counter to get back on track
        vArraycounter = vArraycounter + ?
    Endif
End For 

Любые советы или предложения высоко ценится:)

1 ответ

Решение

Допущения: всегда будет начальный заголовок столбца; в значениях, идущих вниз под начальным заголовком столбца, нет пробелов.

Тогда код ниже является отправной точкой. Вставьте его в модуль и адаптируйте Test sub, поэтому он указывает на местоположение исходного заголовка столбца.

Option Explicit

Public Sub Test()
    Headerize Sheet1.Range("A1")
End Sub

Public Sub Headerize(ByVal prngFirstHeader As Excel.Range)
    Dim rngScan As Excel.Range

    Set rngScan = prngFirstHeader.Cells(3, 1)

    Do Until IsEmpty(rngScan.Value)
        If rngScan.Value <> rngScan.Cells(0, 1).Value Then
            prngFirstHeader.Copy
            rngScan.Insert Shift:=XlInsertShiftDirection.xlShiftDown
        End If

        Set rngScan = rngScan.Cells(2, 1)
    Loop

    Set rngScan = Nothing
End Sub
Другие вопросы по тегам