Excel VBA需求：按A列分组循环生成指定日期范围

需求概述 #

• 以单元格D1的Start Date为起始日期、F1的End Date为结束日期
• 为A3开始的每一组相同编号（A列）的记录，在F列从起始日期开始依次填充日期，每组记录数对应日期数量
• 当A列编号变更时，日期需重新从起始日期开始生成

现有代码仅能一次性生成完整日期范围，无法实现分组重置，示例数据如下：

Start Date  28/04/2023  End Date  04/05/2023
No  Name    Location    Rate    Grade   Date
200 Dan                     28/04/2023
200 Dan                     29/04/2023
200 Dan                     30/04/2023
200 Dan                     01/05/2023
200 Dan                     02/05/2023
200 Dan                     03/05/2023
200 Dan                     04/05/2023
300     Sam                                     28/04/2023
300     Sam                                     29/04/2023
300     Sam                                     30/04/2023
500 Mike                        28/04/2023
500 Mike                        29/04/2023
500 Mike                        30/04/2023
500 Mike                        01/05/2023
500 Mike                        02/05/2023
500 Mike                        03/05/2023
500 Mike                        04/05/2023

现有代码（存在问题） #

Sub IncreaseDate()

Dim FirstDate As Date
Dim myDate As Date
Dim row As Long

FirstDate = Range("D1").Value - 1

NextDate = Range("F1").Value

row = 3

Do Until FirstDate = NextDate
    FirstDate = FirstDate + 1
    Range("F" & row).Value = FirstDate
    Range("G" & row).Value = "=F" & row
    row = row + 1
Loop
End Sub

修正后的代码 #

Sub FillGroupedDates()
    Dim startDate As Date, endDate As Date, currentDate As Date
    Dim lastRow As Long, i As Long
    Dim currentID As String, previousID As String
    
    ' 获取起始和结束日期
    startDate = Range("D1").Value
    endDate = Range("F1").Value
    
    ' 获取A列最后一行数据行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 初始化变量
    previousID = ""
    currentDate = startDate
    
    ' 遍历所有数据行
    For i = 3 To lastRow
        currentID = Cells(i, "A").Value
        
        ' 编号变更时重置日期
        If currentID <> previousID Then
            currentDate = startDate
            previousID = currentID
        End If
        
        ' 填充日期（不超过结束日期）
        If currentDate <= endDate Then
            Cells(i, "F").Value = currentDate
            Cells(i, "G").Formula = "=F" & i
            currentDate = currentDate + 1
        End If
    Next i
    
    ' 设置F列日期显示格式
    Columns("F").NumberFormat = "dd/mm/yyyy"
End Sub

代码说明 #

• 遍历A列从第3行到最后一行的记录，通过对比当前行与上一行的编号判断分组
• 每次分组切换时，将当前日期重置为D1的起始日期
• 逐行填充递增日期，直到达到F1的结束日期
• 保留原代码中G列引用F列的公式逻辑
• 强制设置F列日期格式，确保日期显示符合预期

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