基于日期差插入行并填充日期：修改VBA宏规避Error 1004

我来帮你搞定这两个问题，先处理宏的报错问题，再解决日期填充的需求：

一、修改VBA代码跳过日期相同的行（避免Error 1004） #

Error 1004大多是因为日期相同时，你的插入行逻辑出现了范围冲突或者无效操作。最直接的办法是先判断开始日期和结束日期是否相等，相等就跳过该行的插入操作，同时加上错误处理作为兜底。

给你修改后的示例代码，你可以把原来的插入行逻辑替换进去：

Sub InsertRowsWithoutError()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set ws = ActiveSheet
    ' 获取A列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上遍历，避免插入行打乱行数计数
    For i = lastRow To 2 Step -1
        ' 检查A列（Start Date）和B列（End Date）日期是否相同
        If ws.Cells(i, "A").Value <> ws.Cells(i, "B").Value Then
            ' 临时开启错误跳过，防止其他意外错误
            On Error Resume Next
            ' ↓↓↓ 这里替换成你原来的插入行代码 ↓↓↓
            ws.Rows(i + 1).Insert Shift:=xlDown
            ' 比如复制并均分小时数（根据你的需求调整）
            ws.Cells(i + 1, "C").Value = ws.Cells(i, "C").Value / (ws.Cells(i, "B").Value - ws.Cells(i, "A").Value + 1)
            ws.Cells(i + 1, "D").Value = ws.Cells(i, "D").Value
            ' 恢复默认错误处理
            On Error GoTo 0
        End If
    Next i
End Sub

核心逻辑就是：日期相同的行直接跳过插入操作，从根源避免触发错误。

二、快速填充红色标记的B列连续日期 #

如果想高效搞定这个需求，用VBA自动处理是最简便的，它能自动识别红色标记的单元格，插入需要的行并填充连续日期。下面的代码假设你是用红色字体标记B列，如果是单元格填充红色，把Font.Color改成Interior.ColorIndex = 3即可：

Sub FillRedColumnBDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim startDate As Date
    Dim endDate As Date
    Dim totalDays As Integer
    Dim j As Integer
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上处理，避免插入行影响计数
    i = lastRow
    Do While i >= 2
        ' 检查B列是否为红色标记
        If ws.Cells(i, "B").Font.Color = vbRed Then
            startDate = ws.Cells(i, "A").Value
            endDate = ws.Cells(i, "B").Value
            totalDays = endDate - startDate
            
            If totalDays > 0 Then
                ' 插入需要的空行
                ws.Rows(i + 1 & ":" & i + totalDays).Insert Shift:=xlDown
                ' 逐行填充日期、均分小时数
                For j = 0 To totalDays
                    ws.Cells(i + j, "B").Value = startDate + j
                    ws.Cells(i + j, "C").Value = ws.Cells(i, "C").Value / (totalDays + 1)
                    ws.Cells(i + j, "D").Value = ws.Cells(i, "D").Value
                    ' 取消红色标记（可选，根据你的需求调整）
                    ws.Cells(i + j, "B").Font.Color = vbBlack
                Next j
                ' 更新最后一行的位置
                lastRow = lastRow + totalDays
            ElseIf totalDays = 0 Then
                ' 日期相同的行，直接取消红色标记
                ws.Cells(i, "B").Font.Color = vbBlack
            End If
        End If
        i = i - 1
    Loop
End Sub

如果不想用VBA，手动操作也可以：

• 先筛选出B列红色的行
• 计算每行开始和结束日期的天数差，插入对应数量的空行
• 选中B列的起始日期单元格，按住Ctrl键拖动填充柄，自动填充连续日期
• 把Hours列的值除以（天数+1），复制到每一行即可

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