Question

enter image description here我正在尝试创建一个“ Loop While”宏，以处理excel文件中的B列，如果已填充该单元格，则在其后添加三行以及特定的文本。添加行后，继续向下一行到下一行；如果已填充该单元格，则在该单元格下方添加三行。继续往下移动，直到到达空白单元格

我尝试了简单的Do While循环，但是无法添加行或其他文本

Answer 1

您要添加的文本是第三行。找到带有值的最后一行，然后向后循环。

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

Answer 2

尝试一下：

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

VBA Add循环在每个填充的单元格下方添加三行和文本

2 个答案: