Цикл VBA Add для добавления трех строк и текста под каждую заполненную ячейку

Question

введите описание изображения здесь Я пытаюсь создать макрос "Цикл пока", чтобы обработать столбец B в файле Excel и, если ячейка заполнена, добавить три строки после, вместе с конкретными текст. После добавления строк перейдите к следующей строке и, если ячейка заполнена, добавьте три строки ниже этой ячейки. Продолжайте вниз по столбцу, пока не достигнете пустой ячейки

Я пробовал простой цикл Do While, но не смог добавить строки или дополнительный текст

Answer 1

Попробуйте это:

Sub forloop()
Dim i As Long

vLastRow = Cells.Find(What:="*", After:=Cells(1, 1), searchorder:=xlByRows, SearchDirection:=xlPrevious).Row

For i = vLastRow To 2 Step -1
    If Cells(i, "B") <> "" Then
        Rows(i + 1 & ":" & i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range(Cells(i + 1, "B"), Cells(i + 3, "B")) = "your Text"
    End If
Next

End Sub

Answer 2

Текст, который вы хотите добавить, является третьей строкой. найдите последнюю строку со значениями, затем вернитесь назад.

Sub moveandplace()
    Dim textArr() As Variant
    textArr = Array("Test1", "Test2", "Test3") 'change to your desired text.

    With Worksheets("Sheet1") 'change to your sheet name.
        Dim lstrow As Long
        lstrow = .Cells(.Rows.Count, 2).End(xlUp).Row

        Dim i As Long
        For i = lstrow To 2 Step -1
            Rows(i + 1 & ":" & i + 3).Insert
            .Cells(i + 1, 4).Resize(3).Value = Application.Transpose(textArr)
        Next i
    End With
End Sub