VBA循环问题：仅首个分组补全月初缺失日期，其余分组失效

问题出在If i = 2 Then prevcell = start_date这个判断——它只针对工作表的第2行生效，但筛选不同分组时，当前分组的第一行未必是第2行（其他行被隐藏），所以只有第一个分组能触发月初补全逻辑。

修改方案 #

核心是找到当前筛选分组的第一个可见数据行，然后针对这个行触发月初补全逻辑，而不是固定判断行号为2。

修改后的完整代码如下（关键修改处已标注）：

Sub Macro1()
    Dim aNames As Variant, Itm As Variant

    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=False
        aNames = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value
        For Each Itm In aNames
            .AutoFilter Field:=1, Criteria1:=Itm
            '处理每个分组
            Call Macro2
        Next Itm
        .AutoFilter
    End With
End Sub

Sub Macro2()
    Dim wks As Worksheet, ssh As Worksheet
    Set wks = Worksheets("NAV_REPORT_FSIGLOB1")
    Set ssh = Worksheets("SUMMARY")
    Dim lastRow As Long, start_date As Date, end_date As Date, curcell As Date
    Dim firstVisibleRow As Long '新增：记录当前分组的第一个可见行

    start_date = ssh.Range("A2") - 1
    end_date = ssh.Range("B2")

    '找到当前筛选分组的第一个可见数据行（从第2行开始找）
    firstVisibleRow = wks.Range("D2:D" & Rows.Count).SpecialCells(xlCellTypeVisible).Row

    '获取当前分组的最后一行（可见行的最后一行）
    lastRow = wks.Range("D" & Rows.Count).End(xlUp).Row
    '确认最后一行是当前分组的（因为筛选后可能有隐藏行）
    Do While Not wks.Rows(lastRow).Visible
        lastRow = lastRow - 1
    Loop

    '补全分组末尾到end_date的日期
    With wks.Cells(lastRow, 4)
        If .Value < end_date Then
            .EntireRow.Copy
            .EntireRow.Insert xlShiftDown
            lastRow = lastRow + 1
            .Value = end_date
        End If
    End With

    '倒序遍历补全缺失日期
    For i = lastRow To firstVisibleRow Step -1
        curcell = wks.Cells(i, 4).Value
        If i = lastRow Then curcell = end_date
        prevcell = wks.Cells(i - 1, 4).Value
        
        '关键修改：判断当前行是否是分组的第一个可见行，而不是固定i=2
        If i = firstVisibleRow Then
            prevcell = start_date
        End If

        Do Until curcell - 1 <= prevcell
            wks.Rows(i).Copy
            wks.Rows(i).Insert xlShiftDown
            curcell = wks.Cells(i + 1, 4) - 1
            wks.Cells(i, 4).Value = curcell
        Loop
    Next i
End Sub

关键修改点说明 #

1. 新增获取第一个可见行：通过SpecialCells(xlCellTypeVisible)找到当前筛选分组的第一个数据行，赋值给firstVisibleRow，替代原来固定的行号2。
2. 修正lastRow获取逻辑：原来的lastRow = wks.Range("D2").End(xlDown).Row在筛选后可能指向隐藏行，现在改成从底部往上找并确认行可见，确保是当前分组的最后一行。
3. 替换月初补全的判断条件：把If i = 2 Then改成If i = firstVisibleRow Then，这样每个分组的第一行都会触发将prevcell设为start_date的逻辑，从而补全月初到分组第一个日期之间的缺失日期。

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