使用Excel VBA宏实现数据行按日期递增批量重复N次

原始输入结构 #

工作表初始数据如下，第1行为表头，数据从第2行开始，行数不固定：

目标效果 #

• 保留全部原始数据
• 整组复制原始数据，每复制一组，新组的Date列日期比上一组递增1天
• 其余列内容与原始数据完全一致

示例输出：

原有代码缺陷 #

初始提供的VBA代码仅支持逐行按G列数值插入复制行，不支持整组复制、日期批量递增的逻辑：

Sub Repeat()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
   Next i
End Sub

可直接运行的修正代码 #

Sub RepeatRowsAndIncrementDate()
    Dim ws As Worksheet
    Dim startRow As Long, lastRow As Long, dataRowCount As Long
    Dim repeatCount As Long, i As Long, insertRow As Long
    Dim originalData As Variant
    Dim baseDate As Date
    
    ' ===== 可根据实际需求修改以下配置 =====
    Set ws = ActiveSheet
    startRow = 2 ' 数据起始行，默认第1行为表头
    repeatCount = 2 ' 额外生成的组数，设为2即额外生成+1天、+2天共2组数据
    ' ==================================
    
    ' 读取原始全量数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    dataRowCount = lastRow - startRow + 1
    originalData = ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 6)).Value
    baseDate = ws.Cells(startRow, 1).Value
    
    ' 关闭屏幕更新提升运行效率
    Application.ScreenUpdating = False
    
    ' 逐组生成重复数据
    For i = 1 To repeatCount
        insertRow = lastRow + 1
        ' 批量写入原始数据
        ws.Range(ws.Cells(insertRow, 1), ws.Cells(insertRow + dataRowCount - 1, 6)).Value = originalData
        ' 批量更新当前组日期
        ws.Range(ws.Cells(insertRow, 1), ws.Cells(insertRow + dataRowCount - 1, 1)).Value = baseDate + i
        ' 更新最后一行标记
        lastRow = insertRow + dataRowCount - 1
    Next i
    
    Application.ScreenUpdating = True
End Sub

使用说明 #

• 如果需要调整重复生成的组数，直接修改代码中repeatCount的数值即可
• 代码采用内存数组批量读写的方式，比逐行复制插入的运行速度快很多，数据量大时也不会卡顿
• 如果需要保留原始单元格格式，在循环内写入数据后加一行格式复制的代码即可：ws.Range(ws.Cells(startRow, 1), ws.Cells(startRow + dataRowCount - 1, 6)).Copy: ws.Range(ws.Cells(insertRow, 1), ws.Cells(insertRow + dataRowCount - 1, 6)).PasteSpecial xlPasteFormats

内容的提问来源于stack exchange，提问作者Tech Bro