Excel VBA Worksheet_Change事件IF条件判断异常排查求助

开发者阿泽

2026-9-27

问题根因

浮点数精度误差：VBA中Double类型是二进制浮点数，0.122、0.001这类十进制小数无法被精确存储，加减运算后会产生人眼不可见的微小尾差。你复现的场景中，0.121 + 1.0001 + 0.001理论值是1.1221，但实际运算结果可能为1.122099999999999，Round到4位小数后得到1.1220，和0.122+1.0001的计算结果1.1221不匹配，导致条件判断失败；而J列为0.123时运算尾差刚好不影响Round结果，所以运行正常。
VBA内置Round规则不符合预期：VBA自带的Round函数使用银行家舍入规则（四舍六入五取偶），和Excel工作表的四舍五入规则不一致，也会导致判断结果和预期有偏差。

修复方案

推荐直接替换判断逻辑，用差值绝对值和阈值比较的方式避开浮点数精度和舍入规则的坑，不需要依赖Round函数：

相等判断改为判断差值绝对值小于0.00005（对应四位小数精度下的相等）
差值约为0.001的Marginal场景，判断差值绝对值在0.0009~0.0011区间即可
差值大于等于0.002的Replace场景，判断差值绝对值大于等于0.0019即可

修复后的完整代码如下：

Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, od As Double, nd As Double, q As Integer ' q是列号改为Integer类型
Dim diff As Double

i = Target.Row
q = Target.Column

If Range("K" & i).Value = "Out of Service" Or q <> 10 Then Exit Sub
If IsNumeric(Range("J" & i).Value) = False Then
    Application.EnableEvents = False
        Cells(i, 10).Interior.Color = vbGreen
        Cells(i, 10).Font.Bold = True
        Range("J" & i).Value = "In Use"
    Application.EnableEvents = True
Exit Sub
End If

od = Range("A" & i).Value + 1.0001
nd = Range("J" & i).Value + 1.0001
diff = Abs(od - nd) ' 提前计算差值绝对值减少重复运算

If diff < 0.00005 Then ' 等价于原来的od=nd判断
    Application.EnableEvents = False
        Cells(i, 10).Interior.ColorIndex = 0
        Cells(i, 10).Font.Bold = False
        Range("K" & i).Value = "Good"
    Application.EnableEvents = True
Exit Sub
End If


If diff >= 0.0009 And diff <= 0.0011 Then ' 等价于原来的差0.001的判断
    Application.EnableEvents = False
        Cells(i, 10).Interior.Color = vbYellow
        Cells(i, 10).Font.Bold = True
        Range("K" & i).Value = "Marginal"
    Application.EnableEvents = True

ElseIf diff >= 0.0019 Then ' 等价于原来的差大于等于0.002的判断
    Application.EnableEvents = False
        Cells(i, 10).Interior.Color = vbRed
        Cells(i, 10).Font.Bold = True
        Range("K" & i).Value = "Replace"
    Application.EnableEvents = True
End If

End Sub

如果一定要保留Round的写法，只需要把所有Round()替换为Application.WorksheetFunction.Round()即可，该函数使用常规四舍五入规则，也可以把浮点数先乘10000转成整数再做判断，同样能规避精度问题。

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