VBA比较日期时间值时相等判断不生效的问题咨询

问题场景 #

需要解析带时间戳的Excel工作表统计事件发生次数，所用数据表包含date、hour、instance、day四个表头字段。
实现逻辑：逐行遍历day列，识别到新日期时读取当天首个事件的发生时间，在第11列预置的时间戳列表中匹配该时间值，匹配成功后将第12列对应位置的计数累加1。
原有故障代码如下：

Sub Count()

Dim i As Integer
Dim j As Integer

Dim Day As String
Dim Vrijeme As Date
Dim test As Date


For i = 1 To 5673


If Cells(i, 4).Value <> Day Then   
        Day = Cells(i, 4).Value
        Vrijeme = Cells(i + 1, 2).Value
        
        For j = 5 To 500
        test = Cells(j, 11).Value
        
        
           ' 原标记问题位置：时间相等判断始终无法匹配
           If Vrijeme = test Then     
                counter = Cells(j, 12).Value
                counter = counter + 1
                Cells(j, 12).Value = counter
                
            End If
            DoEvents
            
            
         Next j
        
    End If
    

Next i

End Sub

故障表现：已手动将相关单元格格式设置为Time格式，调试时可确认各变量读取的显示值均正确，但标记的时间相等判断逻辑始终无法成功匹配。

故障诱因 #

• 核心原因：VBA中时间类型本质是双精度浮点数，整数部分代表距离1900/1/1的天数，小数部分代表当日时刻占全天的比例。手动设置单元格格式仅修改显示效果，不会修改单元格底层存储的浮点值。如果时间值来自公式计算、外部系统导入，很容易出现两个时间显示完全一致，但底层小数部分存在极微小平差（比如差值小于1毫秒）的情况，直接用=做全等判断必然失败。
• 代码隐患1：使用VBA内置函数名Day作为自定义变量名，Day()本身是用于提取日期中日序号的内置函数，重名会引发隐式类型转换异常，干扰值判断逻辑。
• 代码隐患2：counter变量未显式声明，默认作为Variant类型参与运算，存在类型不匹配风险。
• 代码隐患3：VBA仅支持单引号'作为注释标识符，原代码标记问题时使用的//不符合VBA语法规则，会触发编译错误。
• 代码隐患4：循环变量声明为Integer类型，该类型最大支持值为32767，虽然当前遍历范围未超限，但数据量上涨时极易出现溢出错误。

修复方案 #

1. 放弃全等判断逻辑，改为判断两个时间的差值绝对值小于1秒（1秒对应的VBA时间序列值为1/86400，即1天除以全天86400秒），只要差值在精度允许范围内就判定为匹配，规避浮点误差影响。如果业务仅需匹配到分钟级精度，可将阈值调整为1/1440（1分钟对应的时间序列值），容错性更高。
2. 重命名和内置函数重名的变量，所有变量显式声明，代码开头添加Option Explicit强制变量校验，避免隐式类型转换问题。
3. 将循环变量类型修改为Long，规避溢出风险，修正注释写法，保留原有业务逻辑不变。

修复后可正常运行的代码如下：

Option Explicit

Sub CountEvent()
    Dim i As Long, j As Long
    Dim currDay As String
    Dim Vrijeme As Date, test As Date
    Dim counter As Long
    
    ' 遍历数据行
    For i = 1 To 5673
        ' 识别到新日期
        If Cells(i, 4).Value <> currDay Then
            currDay = Cells(i, 4).Value
            ' 读取当日首个事件时间
            Vrijeme = Cells(i + 1, 2).Value
            
            ' 遍历预置时间戳列表匹配
            For j = 5 To 500
                test = Cells(j, 11).Value
                ' 差值小于1秒即判定为匹配，规避浮点误差
                If Abs(Vrijeme - test) < 1 / 86400 Then
                    counter = Cells(j, 12).Value
                    counter = counter + 1
                    Cells(j, 12).Value = counter
                End If
                DoEvents
            Next j
        End If
    Next i
End Sub

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