如何使用VBA循环按14天增量填充指定单元格日期并修正起始日期问题

修正后代码 #

Sub FillDateBy14Days()
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim fillRow As Long
    
    ' 读取配置的起止日期
    startDate = Range("A2").Value
    endDate = Range("B3").Value
    currentDate = startDate
    fillRow = 2 ' 从A2行开始填充
    
    ' 循环填充直到超过终止日期
    Do While currentDate <= endDate
        Range("A" & fillRow) = currentDate
        ' 按14天为单位增量
        currentDate = DateAdd("d", 14, currentDate)
        fillRow = fillRow + 1
    Loop
End Sub

核心修改说明 #

• 修复起始日期读取错误：原代码错误读取A1单元格作为起始值，改为读取A2的指定起始日期，解决默认从1900年开始的问题
• 替换增量逻辑：删除原代码按行号+1的逻辑，使用DateAdd("d", 14, currentDate)实现固定14天的日期增量，同时保留原有的「月/日/年 时:分」格式
• 优化终止判断：改用Do While循环直接判断当前日期是否超过B3设置的终止日期，符合业务停止规则
• 变量类型规范：明确声明日期和行号变量类型，避免Val()强制转换造成的日期值异常

如果你的A3已经手动填写了首次增量日期不想被覆盖，只需将fillRow初始值改为3，currentDate初始值改为Range("A3").Value即可。

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