Прошу помочь c доработкой макроса по заполнению строк

[Viktor_]

В VBA я слоабоват. Но все же пытаюсь кое чему обучиться.
Есть макрос ( работает неплохо но его нужно дополнить, не пойму как )
Текс макроса ( кое что с интернета кое что с помошью конструктора ):

Option Explicit
Sub SHD_AddRows()
  Dim ColN As Integer, LR As Long, i As Long
  ColN = 29 'номер колонки для поиска количества строк
  LR = Cells(Rows.Count, ColN).End(xlUp).Row 'Определяем номер последней строки
  For i = LR To 1 Step -1 'Идем цыклом снизу вверх чтоб не вызвать зацыкливания
    If Val(Cells(i, ColN)) > 0 Then 'проверяем значение из ячейки на условие больше нуля
      Rows(i + 1 & ":" & i + Cells(i, ColN)).Insert 'вставляем строки
    End If
  Next
  
  Range("B2:S2,B4:S4").Select
    
Range("B4").Activate
    
Selection.Copy
Range("BA3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("BA6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Range("BA6:BA23").Select
Application.CutCopyMode = False
ActiveSheet.Range("$BA$6:$BA$23").RemoveDuplicates Columns:=1, Header:= _
        xlYes
Range("BB6:BB23").Select
ActiveSheet.Range("$BB$6:$BB$23").RemoveDuplicates Columns:=1, Header:=xlNo


Range("BD6").Select
ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-2],""-"",R[1]C[-2],""-"",R[2]C[-2],""-"",R[3]C[-2],""-"",R[4]C[-2],""-"",R[5]C[-2],""-"",R[6]C[-2],""-"",R[7]C[-2],""-"",R[8]C[-2],""-"",R[9]C[-2],""-"",R[10]C[-2],""-"",R[11]C[-2],""-"",R[12]C[-2],""-"",R[13]C[-2],""-"",R[14]C[-2],""-"",R[15]C[-2],""-"",R[16]C[-2],""-"",R[17]C[-2])"
Range("BC6").Select
ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-2],""-"",R[1]C[-2],""-"",R[2]C[-2],""-"",R[3]C[-2],""-"",R[4]C[-2],""-"",R[5]C[-2],""-"",R[6]C[-2],""-"",R[7]C[-2],""-"",R[8]C[-2],""-"",R[9]C[-2],""-"",R[10]C[-2],""-"",R[11]C[-2],""-"",R[12]C[-2],""-"",R[13]C[-2],""-"",R[14]C[-2],""-"",R[15]C[-2],""-"",R[16]C[-2],""-"",R[17]C[-2])"
Range("BC6").Select
Selection.Copy

Range("T2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Range("BD6").Select
Application.CutCopyMode = False
Selection.Copy
 
 
Range("T4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Columns("BA:BR").Select
Selection.Delete Shift:=xlToLeft

End Sub

в итоге получаю таблицу см. во вложении :



Что мне нужно?
У нас появились пустые строки. так вот мне нужно их заполнить та еще и таким образом чтобы пустой ячейке присваивался порядковый номер начиная с последней заполненой ячейки.

Например ячейка А10 = RAA33IZ027
ячейка А11 - ПУСТА - НО В НЕЙ НУЖНО СДЕЛАТЬ RAA33IZ027-1
ячейка А12 - ПУСТА - НО В НЕЙ НУЖНО СДЕЛАТЬ RAA33IZ027-2
ячейки А13, А14, А15 - ЗАПОЛНЕНЫ ОСТАЮТСЯ НЕ ТРОНУТЫ
далее ячейка А16 = RAT42IA056
ячейка А17- ПУСТА - НО В НЕЙ НУЖНО СДЕЛАТЬ RAT42IA056-1

И ТАК ДАЛЕЕ.

Буду благодарен за помощь.

[AleksandrH]

А после А26 сколько будет строк?

[Viktor_]

Хороший вопрос.
Важный ньюанс в колоне № 26 ( колонка AC ) Указанно сколько строк добавляет макрос. Возможно как-то привязаться к колонке 26.
Логика примерно такова:
если значение в ячейке AC10 = 1 и ячейка A11="" то в ячейку A11 вставить (А10;-1)
если значение в ячейке AC10 = 2 и ячейка A11="" и ячейка A12="" то в ячейку A11 вставить (А10;-1) а в ячейку A12 (А10;-2)
если значение в ячейке AC10 = 3 то в ячейку A11 вставить (А10;-1) а в ячейку A12 (А10;-2) а в ячейку A13 (А10;-2) и ячейка A11="" и ячейка A12="" и ячейка A13=""
и так далее..
проблемма в том что количество пустых ячеек которые нужно будет заполнить после занятой ячеки может быть 30 шт.

[AleksandrH]

[Viktor_]

Дякую зараз спробую =)))

[Viktor_]

 Sub layer()
Dim irowscounter As Integer
Dim icolarows As Long
Dim icurrline As Long, strCurrLine As String, iAC As Integer, i As Integer
icolarows = Cells(Rows.Count, 1).End(x1Up).Row
icurrline = 10
Do While icurrline <= icolarows + Int(Range("AC" & icolarows).Value)
strCurrLine = Cells(icurrline, 1)
iAC = Int(Range("AC" & icurrline))
For i = 1 To iAC
If Cells(icurrline + i, 1) <> "" Then
MsgBox "Помилка рядку" & icurreline + i, vbCritical
Exit For
Else
Cells(icurrline + i, 1) = strCurrLine & "-" & i
End If
Next
icurrline = icurrline + iAC + 1
Loop

End Sub

хмм ошибочка =((( код перепроверил вродь все так же.

[Viktor_]

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

 
Option Explicit
Sub layer()
Dim irowscounter As Integer
Dim icolarows As Long
Dim icurrline As Long, strCurrLine As String, iAC As Integer, i As Integer
icolarows = Cells(Rows.Count, 1).End(x1Up).Row
icurrline = 10
Do While icurrline <= icolarows + Int(Range("AC" & icolarows).Value)
strCurrLine = Cells(icurrline, 1)
iAC = Int(Range("AC" & icurrline))
For i = 1 To iAC
If Cells(icurrline + i, 1) <> "" Then
MsgBox "Помилка рядку" & icurreline + i, vbCritical
Exit For
Else
Cells(icurrline + i, 1) = strCurrLine & "-" & i
End If
Next
icurrline = icurrline + iAC + 1
Loop

End Sub

хмм ошибочка =((( код перепроверил вродь все так же.

Проблема ошибки решена.
Option Explicit - забыл )))) кстати если можете разьясните что делает эта строка ( не совсем понимаю )

[Viktor_]

Но теперь вот так ругаеться =(

[Hugo121]

Уберите Option Explicit - ругаться перестанет...
В чём ошибка - извините, не вижу, лупу дома забыл....

[AleksandrH]

option explicit требует обявления всех переменных

Cells(Rows.Count, 1).End(xlUp).Row

и в msgbox ошибка в имени переменной. Без optionexplicit компилятор пропустит, а с - вкажет на косяк.

ну и

Dim irowscounter As Integer

можна удалить