vba - 将行复制并粘贴到新工作表中，并根据其他单元格值更改单元格值(月份)

Question

我有一个事件表，其中 X 为频率(每 X 个月一次)，第一个开始日期和结束日期如下:

如何复制每一行并将其粘贴到新工作表中，并根据 X 和月份日期的增量为每一行添加附加行，如下所示:

Answer 1

这里是基于所描述问题的解决方案

Sub test()
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim x&, cnt&, cl As Range, SDt$, EDt$, Dif As Date, Key As Variant
With Sheets("Source")
    x = .Cells(Rows.Count, "A").End(xlUp).Row
    For Each cl In .Range(.[A2], .Cells(x, "A"))
        cnt = 1
        Dic.Add cnt & ";" & cl.Text & ";" & cl.Offset(, 2).Text & ";" & cl.Offset(, 3).Text, Nothing
        Dif = DateAdd("m", cl.Offset(, 1).Value, cl.Offset(, 3).Value)
        While Year(Dif) = 2015
            cnt = cnt + 1
            SDt = Right("0" & Month(Dif), 2) & "-" & Right("0" & Day(cl.Offset(, 2).Value), 2) & "-" & Year(Dif)
            EDt = Right("0" & Month(Dif), 2) & "-" & Right("0" & Day(cl.Offset(, 3).Value), 2) & "-" & Year(Dif)
            Dic.Add cnt & ";" & cl.Text & ";" & SDt & ";" & EDt, Nothing
            Dif = DateAdd("m", cl.Offset(, 1).Value, Dif)
        Wend
    Next cl
End With
Sheets("Output").Activate: x = 2 ''
With Sheets("Output")
    For Each Key In Dic
       .Range(.Cells(x, 1), Cells(x, 4)) = Split(Key, ";")
        x = x + 1
    Next Key
    .[C1:D1].Value = Sheets("Source").[C1:D1].Value
    .[B1] = Sheets("Source").[A1]
    .[A1] = "TASK ITERATION"
End With
End Sub

初始工作表

输出表