VBA_12_批量插入N行（N不固定）

有这样一个需求，需要在每条记录下面插入N行，N不固定。

这个需求一般是为了适应系统而调整的格式，话不多说……

源文件：

需要实现的效果：

思路：

每条记录下面插入N行，所以用到两次定位（类似于Excel中offset函数的功能），首行和尾行不适用，需单独处理。

代码如下：

Sub InsertMultipleRows()

'因for循环语句规则，需要单独处理首行和尾行

    Dim i%, nrow%, n%, k%

    n = Sheets("明细").Range("e" & 2).End(xlDown).Value

    rows(3 & ":" & n + 2).Insert Shift:=xlDown

    rows(Cells(rows.Count, 1).End(xlUp).Row & ":" & Cells(rows.Count, 1).End(xlUp).Row).Select

    Selection.Copy

    Selection.Insert Shift:=xlDown

    For i = 2 To 10   '记录条数

        k = Sheets("明细").Range("A" & Sheets("明细").Cells(rows.Count, 1).End(xlUp).Row).End(xlUp).Row

        nrow = Sheets("明细").Range("e" & Sheets("明细").Cells(rows.Count, 1).End(xlUp).Row).End(xlUp).Value

        rows(k + 1 & ":" & nrow + k).Insert Shift:=xlDown

    Next i

    rows(Cells(rows.Count, 1).End(xlUp).Row & ":" & Cells(rows.Count, 1).End(xlUp).Row).Delete

End Sub

详见附件~

<纯原创>

• p1.png
• p2.png
• 批量插入多行.rar