2007-2010年访问综述



我有一个要求在Access 2007中汇总到2dp,并尝试使用该论坛上类似查询的答案,但除了一个之外,其他都发现了错误。有没有人有一个经过测试的VB脚本/函数,它可以接收一个可能有14位小数的值,并输出到2 dp?

事实上:

' Common constants.
'
' Base values.
Public Const Base2      As Double = 2
Public Const Base10     As Double = 10
' Enums.
'
Public Enum rmRoundingMethod
Down = -1
Midpoint = 0
Up = 1
End Enum

' Rounds Value up with count of decimals as specified with parameter NumDigitsAfterDecimal.
'
' Rounds to integer if NumDigitsAfterDecimal is zero.
'
' Optionally, rounds negative values away from zero.
'
' Uses CDec() to prevent bit errors of reals.
'
' Execution time is about 0.5µs for rounding to integer,
' else about 1µs.
'
' 2018-02-09. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RoundUp( _
ByVal Value As Variant, _
Optional ByVal NumDigitsAfterDecimal As Long, _
Optional ByVal RoundingAwayFromZero As Boolean) _
As Variant
Dim Scaling     As Variant
Dim ScaledValue As Variant
Dim ReturnValue As Variant
' Only round if Value is numeric and ReturnValue can be different from zero.
If Not IsNumeric(Value) Then
' Nothing to do.
ReturnValue = Null
ElseIf Value = 0 Then
' Nothing to round.
' Return Value as is.
ReturnValue = Value
Else
If NumDigitsAfterDecimal <> 0 Then
Scaling = CDec(Base10 ^ NumDigitsAfterDecimal)
Else
Scaling = 1
End If
If Scaling = 0 Then
' A very large value for NumDigitsAfterDecimal has minimized scaling.
' Return Value as is.
ReturnValue = Value
ElseIf RoundingAwayFromZero = False Or Value > 0 Then
' Round numeric value up.
If Scaling = 1 Then
' Integer rounding.
ReturnValue = -Int(-Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
On Error Resume Next
ScaledValue = -Int(CDec(-Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ScaledValue = -Int(-Value * Scaling)
ReturnValue = ScaledValue / Scaling
End If
End If
Else
' Round absolute value up.
If Scaling = 1 Then
' Integer rounding.
ReturnValue = Int(Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
On Error Resume Next
ScaledValue = Int(CDec(Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ScaledValue = Int(Value * Scaling)
ReturnValue = ScaledValue / Scaling
End If
End If
End If
If Err.Number <> 0 Then
' Rounding failed because values are near one of the boundaries of type Double.
' Return value as is.
ReturnValue = Value
End If
End If
RoundUp = ReturnValue
End Function

示例

Value14 = CDec("12345.00000000000001")
Value02 = RoundUp(Value14, 2) 
Value02 -> 12345.01 

你也可以学习我关于以极端精度舍入的文章

向上、向下、按4/5或有效数字四舍五入

(如果您没有帐户,请浏览链接:阅读全文(

完整代码也在GitHub:VBA上。Round

最新更新