Макросы для вставки строки заголовка при начале новой группы
Я пытаюсь создать новый код, который будет копировать и вставлять столбец заголовка (из строки 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