根据单元格值插入行并填写

时间:2019-05-17 07:00:32

标签: excel vba insert rows

例如,我目前有一张表格,其值看起来像这样:

1 A     B     C     D..............
2 1     Title of item 1
3       Formulas and formatting 1
4 2     Title of item 2
5       Formulas and formatting 2
6 3     Title of item 3
7       Formulas and formatting 3

我要发生的是代码查找A列。如果A列包含数字> 1,则它将插入该数字(-1)行,但向下插入2行。然后,我需要它填充公式(公式需要向下拖动),并从上方的行向下格式化为该部分插入的最后一行。所以看起来像这样:

1 A     B     C     D...............
2 1     Title of item 1
3       Formulas and formatting 1
4 2     Title of item 2
5       Formulas and formatting 2
6       Formulas and formatting 2
7 3     Title of item 3
8       Formulas and formatting 3
9       Formulas and formatting 3
10      Formulas and formatting 3

以此类推...等等。注意,它需要拖动整个行的公式和格式,而不仅仅是A-D ...

我想下面的代码差不多可以用了,但是我无法让它用公式的第一行填充到A中的值下,直到为该部分插入最后一行为止。 / p>

这是我的代码:

Sub Add_Rows()
  Dim r As Long

  Application.ScreenUpdating = False
  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(r, "A").Value > 1 Then Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert

  Next r
  Application.ScreenUpdating = True
End Sub

如果有人可以帮助我完成上述工作,那就太好了!!同样,我认为我的方法可能有点笨拙,因此我也愿意接受更有说服力的解决方案!谢谢你们,这个论坛救了我很多次皮肤!!!希望有一天,我会达到一个可以回答一些问题而不是总是问他们的地方!

1 个答案:

答案 0 :(得分:0)

尝试一下。您实际上并没有复制和粘贴任何内容。

Sub Add_Rows()

  Dim r As Long

  Application.ScreenUpdating = False

  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If IsNumeric(Cells(r, "A")) Then
        If Cells(r, "A").Value > 1 Then
            Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert shift:=xlDown
            Rows(r + 1).Copy
            Rows(r + 2).Resize(Cells(r, "A").Value - 1).PasteSpecial xlPasteAll
        End If
    End If
  Next r

  Application.ScreenUpdating = True
  Application.CutCopyMode = False
  Application.Goto Range("A1")

End Sub