VBA实现日期逐月递增触发1004错误，求排查解决

问题原因分析 #

1. 变量声明不规范：VBA中Dim d1, d2 As Date的写法仅将d2声明为Date类型，d1实际是Variant类型。InputBox返回的是字符串，若输入日期格式不被系统识别，d1无法正确转换为日期，后续调用EDate时触发1004错误。
2. 依赖单元格取值的风险：循环中每次从单元格Cells(3, i+2)读取值计算下一个日期，若单元格格式设置不当（比如日期被转为文本），EDate会因参数不是有效日期报错。
3. WorksheetFunction.EDate容错性差：该方法遇到无效参数会直接抛出运行时错误1004，而非返回错误值，没有缓冲空间。

修复后的代码 #

Sub add_month()
    Dim d1 As Date, d2 As Date
    Dim dif As Integer, i As Integer
    Dim inputStr As String
    
    ' 验证并获取起始日期
    Do
        inputStr = InputBox("Put the begin date (e.g., 31.03.2023)")
        If inputStr = "" Then Exit Sub ' 用户取消输入
        On Error Resume Next
        d1 = DateValue(Replace(inputStr, ".", "/")) ' 转换点分隔的日期格式
        On Error GoTo 0
    Loop Until IsDate(d1)
    
    ' 验证并获取结束日期
    Do
        inputStr = InputBox("Put the end date (e.g., 31.05.2023)")
        If inputStr = "" Then Exit Sub
        On Error Resume Next
        d2 = DateValue(Replace(inputStr, ".", "/"))
        On Error GoTo 0
    Loop Until IsDate(d2)
    
    dif = DateDiff("m", d1, d2)
    Worksheets("Sheet1").Cells(5, 1) = dif
    
    ' 写入起始日期并设置单元格格式
    With Worksheets("Sheet1").Cells(3, 3)
        .Value = d1
        .NumberFormat = "dd.mm.yyyy"
    End With
    
    ' 逐月生成日期，直接基于d1递推，避免依赖单元格
    Dim currentDate As Date
    currentDate = d1
    For i = 1 To dif
        currentDate = Application.EDate(currentDate, 1)
        With Worksheets("Sheet1").Cells(3, i + 3)
            .Value = currentDate
            .NumberFormat = "dd.mm.yyyy"
        End With
    Next i
End Sub

关键改进点 #

• 规范变量声明：明确d1和d2都是Date类型，避免类型歧义。
• 日期输入验证：通过循环确保用户输入有效日期，同时将点分隔的格式转换为系统可识别的斜杠格式。
• 直接递推日期：基于变量currentDate计算下一个月，无需读取单元格值，避免格式问题导致的错误。
• 使用Application.EDate：相比WorksheetFunction.EDate，它在遇到异常时返回错误值而非直接崩溃，适配VBA调用场景。
• 统一单元格格式：设置单元格格式为dd.mm.yyyy，确保显示的日期符合需求。

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