Question

目前我有一个vba代码，它将复制行x次，具体取决于特定值的单元格。

它完美无缺，但我需要你的帮助来进一步改进它。在我的一个单元格中，我有日期值，每当我插入一行时，我希望它增加+1天。

这是我目前的代码：

Sub CopyData()
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
    VInSertNum = Cells(xRow, "E")
    If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
       Range(Cells(xRow, "A"), Cells(xRow, "E")).Copy
       Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "E")).Select
       Selection.Insert Shift:=xlDown
       xRow = xRow + VInSertNum - 1
    End If
    xRow = xRow + 1
Loop
Application.ScreenUpdating = True
End Sub

示例数据

  Name           Date      Number of Duplicates
 Michael      05/06/2018              2
 Jane         07/06/2018              2

期望的输出：

 Name           Date       Number of Duplicates
Michael      05/06/2018              2
Michael      05/07/2018              2
Jane         07/06/2018              2
Jane         07/07/2018              2

Answer 1

一种方法是在Cells(xRow, 2).Value = Cells(xRow, 2).Value + 1之前添加End If。

Sub CopyData()
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
    VInSertNum = Cells(xRow, "E")
    If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
       Range(Cells(xRow, "A"), Cells(xRow, "E")).Copy
       Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "E")).Select
       Selection.Insert Shift:=xlDown
       xRow = xRow + VInSertNum - 1
       Cells(xRow, 2).Value = Cells(xRow, 2).Value + 1
    End If
    xRow = xRow + 1
Loop
Application.ScreenUpdating = True
End Sub

插入新行并在单元格内增加日期

1 个答案: