如何优化VBA从FILETIME提取年份的自定义函数的测试方案

DevOps 小满

2026-10-5

VBA FILETIME年份提取函数测试方案评估与优化建议

你当前的随机测试方案已经覆盖了绝大多数常规日期场景，100万次无报错已经可以证明函数在常用时间范围（1601-9999年）的稳定性。但随机测试的天然缺陷是边界场景命中概率极低，确实存在覆盖缺口。

首先澄清一个认知误区：你担心的时区、本地时制、夏令时问题完全不需要纳入测试范围，因为FILETIME本身是基于UTC的绝对时间刻度，不涉及任何本地时间规则，你的函数输入仅为纯FILETIME刻度值，所以这类场景不会对输出产生任何影响。

现存测试方案的不足

仅覆盖到9999年，未覆盖SYSTEMTIME支持的最大合法年份30827年的范围
未针对性测试年份切换、闰年临界、极值等边界场景，随机测试命中这些场景的概率不足百万分之一
未测试大刻度值下的浮点转换精度问题：你代码中使用CDbl(LL_Ticks)做除法，Double类型仅能精确表示小于2^{53（约9e15）的整数，当FILETIME对应年份超过约3000年时，刻度值会超过2}53，此时CDbl转换会丢失精度，导致天数计算错误，这个问题你当前测试到9999年可能都没触发，但更大的年份会出问题

需要补充的测试项

1. 硬边界场景专项测试

最小合法值测试：测试LL_Ticks=0（对应1601-01-01 00:00:00 UTC）的返回值，以及1601年12月31日最后一个刻度的返回值，确保年份计算正确
年切换临界值全量测试：遍历1601年到30827年每一年的1月1日0点整、前一个100纳秒刻度，12月31日最后一个100纳秒刻度，校验返回年份是否正确，总共仅约6万次测试，1秒即可跑完，覆盖度远高于百万次随机测试
闰年特殊边界测试：专项测试1700、1800、1900、2100这类非闰年的世纪年，以及2000、2400这类闰年世纪年的2月28日、2月29日（如果是闰年）、3月1日的临界刻度，确保闰年规则应用正确
最大合法值测试：测试SYSTEMTIME支持的最大年份30827年的所有边界刻度，以及FILETIME最大有效值对应的日期，避免整数溢出错误

2. 类型转换安全性测试

专项测试年份大于3000年的FILETIME刻度，校验CDbl(LL_Ticks)转换是否丢失精度，建议你优化代码直接用LongLong整除：LL_Days = LL_Ticks \ 864000000000，避免浮点转换的精度风险

3. 异常输入测试

测试超出合法范围的LL_Ticks值（比如负数、大于FILETIME最大值的值），确保函数不会崩溃，可根据需求返回错误值或者默认值

代码优化建议

你可以把随机测试替换为全量边界测试，仅需几万次循环即可实现100%的逻辑覆盖，比随机测试效率高得多。另外你代码中的366^如果是要表示Long类型常量，建议改为366&，避免VBA将^识别为幂运算符导致计算错误。

Option Explicit

Private Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As LongLong) As Long
' FILETIME是64位值，表示从1601年1月1日UTC零点开始的100纳秒间隔数
' 这里直接用LongLong类型接收lpFileTime，不需要拆分高低位DWORD

Public Type SYSTEMTIME ' 合法年份范围为1601到30827
    stYear As Integer
    stMonth As Integer
    stDayOfWeek As Integer
    stDay As Integer
    stHour As Integer
    stMin As Integer
    stSec As Integer
    stMilliSec As Integer
End Type


Function funcExtractYearFromFileTimeTicks(LL_Ticks As LongLong) As Integer

        Dim LL_Days As LongLong, liFTYear As Long, liFTYearsFrom1600 As Long, liJan1OfYearFrom1600 As Long, liDec31OfYearFrom1600 As Long, bIsLeapYear As Boolean
        
        ' 从刻度中计算完整天数，每天的100纳秒数为 24*60*60*10000000 = 864000000000
        LL_Days = Int(CDbl(LL_Ticks) / 864000000000#)  ' 这里的类型转换可以优化为LongLong整除避免精度问题
        ' FILETIME的天数从1601年1月1日开始，这里转为从1600年（闰年）1月1日开始方便计算
        LL_Days = LL_Days + 366
        ' 公历平均每年天数为(365*400+100-3)/400=365.2425天
        liFTYearsFrom1600 = Int(CDbl(LL_Days) / 365.2425)      ' 估算1600年以来的年数，误差最大为±1年
        liFTYear = liFTYearsFrom1600 + 1600
        bIsLeapYear = isLeapYear(CInt(liFTYear))
        liJan1OfYearFrom1600 = liFTYearsFrom1600 * 365 + Int(liFTYearsFrom1600 / 4) - Int(liFTYearsFrom1600 / 100) + Int(liFTYearsFrom1600 / 400)
        If Not (bIsLeapYear) Then liJan1OfYearFrom1600 = liJan1OfYearFrom1600 + 1    ' 计算从1600年1月1日到估算年份1月1日的完整天数
        If bIsLeapYear Then liDec31OfYearFrom1600 = liJan1OfYearFrom1600 + 365 Else liDec31OfYearFrom1600 = liJan1OfYearFrom1600 + 364 ' 计算到估算年份12月31日的完整天数

        ' 校验实际天数是否落在估算年份的区间内，不在的话调整年份
        If LL_Days < liJan1OfYearFrom1600 Then
                liFTYear = liFTYear - 1
        ElseIf LL_Days > liDec31OfYearFrom1600 Then
                liFTYear = liFTYear + 1
        End If
        
        funcExtractYearFromFileTimeTicks = liFTYear
End Function


Sub TEST_ExtractYearFromFileTimeTicks()

    Dim stUTCSystemTime As SYSTEMTIME, LL_UTC_FTTicks As LongLong
    Dim iFTYear As Integer, iSTYear As Integer, iMonth As Integer, iDay As Integer, dTimeStart As Double, dTimeElapsed As Double
 '#################################
    Dim liLoop As Long, liMaxLoops As Long:    liMaxLoops = 120000   ' 本机测试12万次循环约需10秒，单次循环约80微秒
'#################################
    dTimeStart = Timer
    For liLoop = 1 To liMaxLoops
            ' 生成随机SYSTEMTIME，转换为FILETIME后校验提取的年份是否一致
                                iSTYear = Application.RandBetween(1601, 9999)     ' VBA的Weekday函数仅支持到9999年，SYSTEMTIME最大支持到30827年
                                stUTCSystemTime.stYear = iSTYear
                                iMonth = Application.RandBetween(1, 12)                 ' 随机月份
                                stUTCSystemTime.stMonth = iMonth
                                                                                                                ' 根据月份和是否闰年生成随机日期
                                If (iMonth = 1 Or iMonth = 3 Or iMonth = 5 Or iMonth = 7 Or iMonth = 8 Or iMonth = 10 Or iMonth = 12) Then
                                            iDay = Application.RandBetween(1, 31)
                                ElseIf iMonth = 4 Or iMonth = 6 Or iMonth = 9 Or iMonth = 11 Then
                                            iDay = Application.RandBetween(1, 30)
                                ElseIf isLeapYear(iSTYear) Then  ' 二月闰年判断
                                            iDay = Application.RandBetween(1, 29)
                                Else
                                            iDay = Application.RandBetween(1, 28)
                                End If
                                stUTCSystemTime.stDay = iDay
                                stUTCSystemTime.stDayOfWeek = Weekday(iMonth & "/" & iDay & "/" & iSTYear) ' 计算星期
                                stUTCSystemTime.stHour = Application.RandBetween(0, 23)         ' 随机小时
                                stUTCSystemTime.stMin = Application.RandBetween(0, 59)            ' 随机分钟
                                stUTCSystemTime.stSec = Application.RandBetween(0, 59)             ' 随机秒
                                stUTCSystemTime.stMilliSec = Application.RandBetween(0, 999)      ' 随机毫秒

            
            Call SystemTimeToFileTime(stUTCSystemTime, LL_UTC_FTTicks)  ' 转换为FILETIME刻度
            LL_UTC_FTTicks = LL_UTC_FTTicks + Application.RandBetween(0, 9999) ' 增加随机100纳秒偏移，覆盖同一日内的所有刻度
            
            iFTYear = funcExtractYearFromFileTimeTicks(LL_UTC_FTTicks) ' 提取年份
            
            ' 年份不匹配时输出错误信息并停止
            If iFTYear <> iSTYear Then
                        With stUTCSystemTime
                                Debug.Print "--------------"
                                Debug.Print "stYear          "; .stYear
                                Debug.Print "stMonth        "; .stMonth
                                Debug.Print "stDayOfWeek"; .stDayOfWeek
                                Debug.Print "stDay           "; .stDay
                                Debug.Print "stHour          "; .stHour
                                Debug.Print "stMin            "; .stMin
                                Debug.Print "stSec            "; .stSec
                                Debug.Print "stMilliSec       "; .stMilliSec
                        End With
                        Stop
            End If
Next liLoop
dTimeElapsed = Timer - dTimeStart
Debug.Print Format(liMaxLoops, "0,000"); "次测试成功完成"; vbCrLf; _
"总耗时（秒） :  "; Format(dTimeElapsed, "0.0"); vbCrLf; _
"单次循环耗时（毫秒）: "; Format(dTimeElapsed * 1000 / liMaxLoops, "0.00"); vbCrLf; "--------------------------"; vbCrLf; vbCrLf
End Sub


Function isLeapYear(Y As Integer) As Boolean
' 高效闰年判断函数
    If Y Mod 4 Then Exit Function  ' 不能被4整除则不是闰年
    If Y Mod 100 Then  ' 能被4整除但不能被100整除则是闰年
    ElseIf Y Mod 400 Then Exit Function  ' 能被100整除但不能被400整除则不是闰年
    End If
    isLeapYear = True
End Function

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

如何优化VBA从FILETIME提取年份的自定义函数的测试方案

现存测试方案的不足 #

需要补充的测试项 #

1. 硬边界场景专项测试 #

2. 类型转换安全性测试 #

3. 异常输入测试 #