VBA代码优化需求：补全指定起止日期间的缺失日期行

以下是修改后的VBA代码，可实现从「Summary」工作表A2、B2指定的起止日期范围内，补全所有缺失日期行，且新增行自动复制下方（表头前缺失则复制第一行，表尾缺失则复制最后一行）单元格的数据：

Sub CompleteAllMissingDates()
    Dim navSheet As Worksheet
    Dim summarySheet As Worksheet
    Dim startDate As Date
    Dim endDate As Date
    Dim firstDataDate As Date
    Dim lastDataDate As Date
    Dim currentRow As Long
    Dim i As Long
    
    ' 绑定目标工作表
    Set navSheet = ThisWorkbook.Worksheets("NAV_REPORT_FSIGLOB1")
    Set summarySheet = ThisWorkbook.Worksheets("Summary")
    
    ' 获取并验证起止日期有效性
    On Error Resume Next
    startDate = summarySheet.Range("A2").Value
    endDate = summarySheet.Range("B2").Value
    On Error GoTo 0
    
    If IsDate(startDate) = False Or IsDate(endDate) = False Then
        MsgBox "Summary表A2/B2必须是有效日期！", vbExclamation
        Exit Sub
    End If
    If startDate > endDate Then
        MsgBox "起始日期不能晚于结束日期！", vbExclamation
        Exit Sub
    End If
    
    ' 获取现有数据的最早、最晚日期（D列为日期列，数据从D2开始）
    currentRow = navSheet.Range("D2").End(xlDown).Row
    firstDataDate = navSheet.Range("D2").Value
    lastDataDate = navSheet.Cells(currentRow, 4).Value
    
    ' --------------------------
    ' 1. 补全起始日期到现有最早日期之间的缺失行
    ' --------------------------
    If startDate < firstDataDate Then
        ' 反向循环插入，避免行号错乱
        For i = firstDataDate - 1 To startDate Step -1
            navSheet.Rows(2).Insert xlShiftDown
            ' 复制下方行数据到新插入行
            navSheet.Rows(3).Copy navSheet.Rows(2)
            ' 更新新行日期
            navSheet.Cells(2, 4).Value = i
        Next i
        ' 更新数据边界
        currentRow = navSheet.Range("D2").End(xlDown).Row
        firstDataDate = navSheet.Range("D2").Value
    End If
    
    ' --------------------------
    ' 2. 补全现有数据中间的缺失行
    ' --------------------------
    For currentRow = navSheet.Range("D2").End(xlDown).Row To 3 Step -1
        Dim curDate As Date
        Dim prevDate As Date
        curDate = navSheet.Cells(currentRow, 4).Value
        prevDate = navSheet.Cells(currentRow - 1, 4).Value
        
        Do Until curDate - 1 <= prevDate
            navSheet.Rows(currentRow).Insert xlShiftDown
            ' 复制下方行数据到新插入行
            navSheet.Rows(currentRow + 1).Copy navSheet.Rows(currentRow)
            curDate = curDate - 1
            navSheet.Cells(currentRow, 4).Value = curDate
        Loop
    Next currentRow
    
    ' --------------------------
    ' 3. 补全现有最晚日期到结束日期之间的缺失行
    ' --------------------------
    currentRow = navSheet.Range("D2").End(xlDown).Row
    lastDataDate = navSheet.Cells(currentRow, 4).Value
    If endDate > lastDataDate Then
        ' 正向循环插入，逐行追加到表尾
        For i = lastDataDate + 1 To endDate Step 1
            navSheet.Rows(currentRow + 1).Insert xlShiftDown
            ' 复制上方行数据到新插入行
            navSheet.Rows(currentRow).Copy navSheet.Rows(currentRow + 1)
            ' 更新新行日期
            navSheet.Cells(currentRow + 1, 4).Value = i
            currentRow = currentRow + 1
        Next i
    End If
    
    MsgBox "日期补全完成！", vbInformation
End Sub

关键逻辑说明 #

• 日期有效性校验：先验证「Summary」表的起止日期格式是否合法，避免运行报错
• 表头前缺失补全：若起始日期早于现有数据最早日期，反向循环插入行（防止行号偏移），复制下方第一行的数据并修改日期
• 中间数据补全：保留原有反向循环逻辑，调整复制对象为下方行，确保新增行继承对应位置的单元格数据
• 表尾缺失补全：若结束日期晚于现有数据最晚日期，正向循环追加行，复制最后一行的数据并修改日期

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