Rounding in MS Access

后端 未结 12 691
夕颜
夕颜 2020-11-28 14:23

Whats the best way to round in VBA Access?

My current method utilizes the Excel method

Excel.WorksheetFunction.Round(...

But I am l

12条回答
  •  借酒劲吻你
    2020-11-28 15:14

    Unfortunately, the native functions of VBA that can perform rounding are either missing, limited, inaccurate, or buggy, and each addresses only a single rounding method. The upside is that they are fast, and that may in some situations be important.

    However, often precision is mandatory, and with the speed of computers today, a little slower processing will hardly be noticed, indeed not for processing of single values. All the functions at the links below run at about 1 µs.

    The complete set of functions - for all common rounding methods, all data types of VBA, for any value, and not returning unexpected values - can be found here:

    Rounding values up, down, by 4/5, or to significant figures (EE)

    or here:

    Rounding values up, down, by 4/5, or to significant figures (CodePlex)

    Code only at GitHub:

    VBA.Round

    They cover the normal rounding methods:

    • Round down, with the option to round negative values towards zero

    • Round up, with the option to round negative values away from zero

    • Round by 4/5, either away from zero or to even (Banker's Rounding)

    • Round to a count of significant figures

    The first three functions accept all the numeric data types, while the last exists in three varieties - for Currency, Decimal, and Double respectively.

    They all accept a specified count of decimals - including a negative count which will round to tens, hundreds, etc. Those with Variant as return type will return Null for incomprehensible input

    A test module for test and validating is included as well.

    An example is here - for the common 4/5 rounding. Please study the in-line comments for the subtle details and the way CDec is used to avoid bit errors.

    ' Common constants.
    '
    Public Const Base10     As Double = 10
    
    ' Rounds Value by 4/5 with count of decimals as specified with parameter NumDigitsAfterDecimals.
    '
    ' Rounds to integer if NumDigitsAfterDecimals is zero.
    '
    ' Rounds correctly Value until max/min value limited by a Scaling of 10
    ' raised to the power of (the number of decimals).
    '
    ' Uses CDec() for correcting bit errors of reals.
    '
    ' Execution time is about 1µs.
    '
    Public Function RoundMid( _
        ByVal Value As Variant, _
        Optional ByVal NumDigitsAfterDecimals As Long, _
        Optional ByVal MidwayRoundingToEven As Boolean) _
        As Variant
    
        Dim Scaling     As Variant
        Dim Half        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
            Scaling = CDec(Base10 ^ NumDigitsAfterDecimals)
    
            If Scaling = 0 Then
                ' A very large value for Digits has minimized scaling.
                ' Return Value as is.
                ReturnValue = Value
            ElseIf MidwayRoundingToEven Then
                ' Banker's rounding.
                If Scaling = 1 Then
                    ReturnValue = Round(Value)
                Else
                    ' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
                    ' Very large values for NumDigitsAfterDecimals can cause an out-of-range error 
                    ' when dividing.
                    On Error Resume Next
                    ScaledValue = Round(CDec(Value) * Scaling)
                    ReturnValue = ScaledValue / Scaling
                    If Err.Number <> 0 Then
                        ' Decimal overflow.
                        ' Round Value without conversion to Decimal.
                        ReturnValue = Round(Value * Scaling) / Scaling
                    End If
                End If
            Else
                ' Standard 4/5 rounding.
                ' Very large values for NumDigitsAfterDecimals can cause an out-of-range error 
                ' when dividing.
                On Error Resume Next
                Half = CDec(0.5)
                If Value > 0 Then
                    ScaledValue = Int(CDec(Value) * Scaling + Half)
                Else
                    ScaledValue = -Int(-CDec(Value) * Scaling + Half)
                End If
                ReturnValue = ScaledValue / Scaling
                If Err.Number <> 0 Then
                    ' Decimal overflow.
                    ' Round Value without conversion to Decimal.
                    Half = CDbl(0.5)
                    If Value > 0 Then
                        ScaledValue = Int(Value * Scaling + Half)
                    Else
                        ScaledValue = -Int(-Value * Scaling + Half)
                    End If
                    ReturnValue = ScaledValue / Scaling
                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
    
        RoundMid = ReturnValue
    
    End Function
    

提交回复
热议问题