如何正确比较VBA中的双精度

在不深入研究细节的情况下,浮点数字容易受到精度错误的影响。维基百科有 a pretty good explanation 如何以及为什么会发生这些。一个解释这个错误的好方法是减去目标值,然后测试它们是否低于“delta”值,或者是权益检查的可接受精度。

例如,如果您很好地假定.00000001的差异应被视为相等,那么您的测试将如下所示:

Private Sub calcSumRelativeRatios()
    Const delta As Double = 0.00000001
    Dim val As Double
    val = DSum("RelativeRatio", "ASCs")
    Me.sumTextBox.Value = val
    If Abs(1 - val) < delta Then
        Me.sumTextBox.BorderColor = vbGreen
    ElseIf val > 1 Then
        Me.sumTextBox.BorderColor = vbRed
    Else
        Me.sumTextBox.BorderColor = 16
    End If
End Sub

虽然共产国际的回答在大多数情况下是合理的,但也存在一些问题。首先,delta应该相对于一个测量值(较大的值对double的精确度较大)。对于这个特定的情况,它是可以做到的,因为您总是将其与1进行比较。

另外,最好将它移到一个单独的函数中,因为您可能正在代码或SQL中的多个位置进行比较。

我个人使用这个函数来比较可能是双精度的值。请注意,它执行严格的比较:如果变量类型不相等,则返回false。

Public Function DblSafeCompare(ByVal Value1 As Variant, ByVal Value2 As Variant) As Boolean
    'Compares two variants, dates and floats are compared at high accuracy
    Const AccuracyLevel As Double = 0.00000001
    'We accept an error of 0.000001% of the value
    Const AccuracyLevelSingle As Single = 0.0001
    'We accept an error of 0.0001 on singles
    If VarType(Value1) <> VarType(Value2) Then Exit Function 'No typecasting! Both values should have equal type!
    Select Case VarType(Value1)
        Case vbSingle
            DblSafeCompare = Abs(Value1 - Value2) <= (AccuracyLevelSingle * Abs(Value1))
        Case vbDouble
            DblSafeCompare = Abs(Value1 - Value2) <= (AccuracyLevel * Abs(Value1))
        Case vbDate 'Dates are really doubles
            DblSafeCompare = Abs(CDbl(Value1) - CDbl(Value2)) <= (AccuracyLevel * Abs(CDbl(Value1)))
        Case vbNull 'Note: you might want to set it to false here. I like Null = Null leading to Tru
            DblSafeCompare = True
        Case Else
            DblSafeCompare = Value1 = Value2
    End Select
End Function

实施:

 Private Sub calcSumRelativeRatios()
     Dim val As Double
     val = DSum("RelativeRatio", "ASCs")
     Me.sumTextBox.Value = val
     If val > 1 And Not DblSafeCompare(val, 1#) Then 'Greater than 1 and not equal to 1
        Me.sumTextBox.BorderColor = vbRed
     ElseIf DblSafeCompare(val, 1#) Then '# = constant double, required
        Me.sumTextBox.BorderColor = vbGreen
     Else
        Me.sumTextBox.BorderColor = 16
     End If
  End Sub

虽然这些解释是正确的,但它们并不能解决问题的主要原因,即您为此选择了错误的数据类型。

简单的解决方案是:

Dim val As Currency

您的原始和普通代码将按预期工作。