在新工作表中复制并粘贴行，并根据其他单元格值更改单元格值（月）

我有一个活动表，X为频率（每X个月一次），第一个开始date和结束date如下：

如何复制每一行并将其粘贴到新的工作表中，每个行都基于X添加一行，并在月份date中递增，如下所示：

Answer 1

这里解决scheme基于上述问题

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 

初始表单

输出表