VBA计算日期距今日间隔月份数函数返回0问题排查

你的自定义函数始终返回0，核心是两个问题：

1. API调用错误：VBA没有内置Today()函数，获取当前系统日期的正确方法是调用Date()。你代码中两处使用Today()会直接触发运行时错误，函数执行中断后就会返回默认值0，这是故障的直接原因。
2. 逻辑分支缺失：现有判断跳过了间隔11个月（对应301~330天）的区间判断，落在这个区间的日期无法匹配任何If条件，会返回初始赋值的结果。
   另外你逐一枚举37个月份区间的写法冗余度极高，完全可以用通用计算逻辑替代，不需要写几十行重复判断。

Public Function QProfile(Arg1 As Date) As Integer
    Dim Rdate As Long
    Dim fullYearCount As Integer
    Dim remainDays As Integer
    Dim Result As Integer
    Const MONTH_DAYS As Integer = 30
    Const YEAR_DAYS As Integer = 365
    Const MAX_RESULT As Integer = 37
    
    ' 计算日期间隔天差
    Rdate = Date - Arg1
    ' 处理传入日期晚于当前日期的异常场景
    If Rdate < 0 Then
        QProfile = 0
        Exit Function
    End If
    
    ' 拆分完整年份和剩余天数计算
    fullYearCount = Rdate \ YEAR_DAYS
    remainDays = Rdate Mod YEAR_DAYS
    
    If fullYearCount >= 3 Then
        Result = MAX_RESULT
    Else
        If remainDays = 0 Then
            Result = fullYearCount * 12
        Else
            ' 剩余天数向上取整折算月份，和原区间判断逻辑完全一致
            Result = fullYearCount * 12 + -Int(-remainDays / MONTH_DAYS)
        End If
    End If
    
    QProfile = Result
End Function

如果需要计算真实的自然月间隔（考虑大小月、闰年、日期对齐），不需要自己按天数折算，直接调用VBA内置函数即可：

' 真实自然月间隔计算示例
Public Function QProfileAccurate(Arg1 As Date) As Integer
    QProfileAccurate = DateDiff("m", Arg1, Date)
End Function

另外存储天差的变量建议声明为Long类型，避免两个日期间隔超过32767天（Integer类型上限）时触发溢出错误。

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