Question

我遇到了一个非常简单但奇怪的错误。我有一个文本框，用于显示数据库表中某个字段的总和。如果总和等于1，我想将文本框的边框设置为绿色。如果更大，我想将其设为红色。如果较少，则为灰色。这是我的代码

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

有时，即使总和为1（即val为1），它也会输入第一个if条件并使边框变为红色。在我看来，这似乎是一个VBA错误，但这也许是因为我正在比较两种不同的原始类型。

有人可以向我解释为什么1> 1为真吗？

Answer 1

在不赘述细节的情况下，浮点数容易受到精度误差的影响。维基百科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

Answer 2

尽管在大多数情况下，共产国际的答案是合理的，但它存在一些问题。对于一个，增量应相对于其中一个测量值（较大的值表示双精度值的误差较大）。对于这种特定情况，它会这样做，因为您总是将其与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

Answer 3

虽然这些解释是正确的，但它们并不能解决造成麻烦的主要原因，即您为此目的选择了错误的数据类型。

简单的解决方案是：

Dim val As Currency

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

如何在VBA中正确比较双打

3 个答案: