Question

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

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

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

Answer 1

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

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

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

1 个答案: