Pregunta

¿Cuál es la mejor manera de redondear en VBA Access?

Mi método actual utiliza el método Excel

Excel.WorksheetFunction.Round(...

Pero estoy buscando un medio que no se base en Excel.

¿Fue útil?

Solución

Tenga cuidado, la función VBA Round utiliza el redondeo de Banker, donde redondea .5 a un número par, así:

Round (12.55, 1) would return 12.6 (rounds up) 
Round (12.65, 1) would return 12.6 (rounds down) 
Round (12.75, 1) would return 12.8 (rounds up)   

Mientras que la función de hoja de cálculo Excel se redondea, siempre redondea .5 hacia arriba.

He realizado algunas pruebas y parece que el redondeo hacia arriba .5 (redondeo simétrico) también se usa en el formato de celda, y también para el redondeo de Ancho de columna (cuando se usa el formato de Número general). El indicador 'Precisión como se muestra' no parece redondearse, solo usa el resultado redondeado del formato de celda.

Intenté implementar la función SymArith de Microsoft en VBA para mi redondeo, pero descubrí que Fix tiene un error cuando intentas darle un número como 58.55; La función da un resultado de 58.5 en lugar de 58.6. Luego finalmente descubrí que puedes usar la función Redonda de hoja de cálculo de Excel, así:

  

Application.Round (58.55, 1)

Esto le permitirá hacer redondeos normales en VBA, aunque puede que no sea tan rápido como algunas funciones personalizadas. Me doy cuenta de que esto ha cerrado el círculo de la pregunta, pero quería incluirlo para completarlo.

Otros consejos

Para ampliar un poco la respuesta aceptada:

" La función Round realiza redondeo a par, que es diferente de redondeo a más grande. "
--Microsoft

El formato siempre se redondea.

  Debug.Print Round(19.955, 2)
  'Answer: 19.95

  Debug.Print Format(19.955, "#.00")
  'Answer: 19.96

ACC2000: Errores de redondeo cuando utiliza números de punto flotante: http://support.microsoft.com/ kb / 210423

ACC2000: Cómo redondear un número hacia arriba o hacia abajo por un incremento deseado: http://support.microsoft .com / kb / 209996

Función redonda: http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx

Cómo implementar procedimientos de redondeo personalizados: http://support.microsoft.com/kb/196652

En Suiza y en particular en la industria de seguros, tenemos que usar varias reglas de redondeo, dependiendo de si se trata de un beneficio, etc.

Actualmente uso la función

Function roundit(value As Double, precision As Double) As Double
    roundit = Int(value / precision + 0.5) * precision
End Function

que parece funcionar bien

Int y Fix son funciones útiles de redondeo, que le dan la parte entera de un número.

Int siempre se redondea hacia abajo - Int (3.5) = 3, Int (-3.5) = -4

Fix siempre se redondea hacia cero - Fix (3.5) = 3, Fix (-3.5) = -3

También están las funciones de coerción, en particular CInt y CLng, que intentan forzar un número a un tipo entero o largo (los enteros están entre -32,768 y 32,767, los largos están entre-2,147,483,648 y 2,147,483,647). Ambos se redondearán hacia el número entero más cercano, redondeando desde cero a .5 - CInt (3.5) = 4, Cint (3.49) = 3, CInt (-3.5) = -4, etc.

1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000

y así sucesivamente. A menudo encontrará que soluciones aparentemente poco claras como esta son mucho más rápidas que usar funciones de Excel, porque VBA parece operar en un espacio de memoria diferente.

por ejemplo, If A > B Then MaxAB = A Else MaxAB = B es aproximadamente 40 veces más rápido que usar ExcelWorksheetFunction.Max

Desafortunadamente, las funciones nativas de VBA que pueden realizar el redondeo faltan, son limitadas, inexactas o tienen errores, y cada una aborda un solo método de redondeo. Lo bueno es que son rápidos, y eso en algunas situaciones puede ser importante.

Sin embargo, a menudo la precisión es obligatoria, y con la velocidad de las computadoras hoy en día, apenas se notará un procesamiento un poco más lento, de hecho, no para el procesamiento de valores únicos. Todas las funciones en los enlaces a continuación se ejecutan en aproximadamente 1 & # 181; s.

El conjunto completo de funciones, para todos los métodos de redondeo comunes, todos los tipos de datos de VBA, para cualquier valor y sin devolver valores inesperados, se puede encontrar aquí:

Redondeando los valores hacia arriba, hacia abajo, en 4/5 o a cifras significativas (EE)

o aquí:

Redondeando los valores hacia arriba, hacia abajo, en 4/5, o hasta cifras significativas (CodePlex)

Código solo en GitHub:

VBA.Round

Cubren los métodos normales de redondeo:

  • Redondear hacia abajo, con la opción de redondear valores negativos hacia cero

  • Redondear hacia arriba, con la opción de redondear los valores negativos lejos de cero

  • Redondea por 4/5, ya sea lejos de cero o incluso (Redondeo del banquero)

  • Redondear a un recuento de cifras significativas

Las primeras tres funciones aceptan todos los tipos de datos numéricos, mientras que la última existe en tres variedades: Moneda, Decimal y Doble, respectivamente.

Todos aceptan un recuento específico de decimales, incluido un recuento negativo que se redondeará a decenas, cientos, etc. Aquellos con Variante como tipo de retorno devolverán Nulo para una entrada incomprensible

También se incluye un módulo de prueba para probar y validar.

Aquí hay un ejemplo: para el redondeo 4/5 común. Estudie los comentarios en línea para los detalles sutiles y la forma en que se utiliza CDec para evitar errores de bits.

' 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

Si está hablando de redondear a un valor entero (y no redondear a n lugares decimales), siempre está la forma de la vieja escuela:

return int(var + 0.5)

(Puede hacer que esto funcione para n lugares decimales también, pero comienza a ser un poco desordenado)

Lance ya mencionó el redondeo de herencia bug en la implementación de VBA. Por lo tanto, necesito una función de redondeo real en una aplicación VB6. Aquí hay uno que estoy usando. Se basa en uno que encontré en la web como se indica en los comentarios.

' -----------------------------------------------------------------------------
' RoundPenny
'
' Description:
'    rounds currency amount to nearest penny
'
' Arguments:
'    strCurrency        - string representation of currency value
'
' Dependencies:
'
' Notes:
' based on RoundNear found here:
' http://advisor.com/doc/08884
'
' History:
' 04/14/2005 - WSR : created
'
Function RoundPenny(ByVal strCurrency As String) As Currency

         Dim mnyDollars    As Variant
         Dim decCents      As Variant
         Dim decRight      As Variant
         Dim lngDecPos     As Long

1        On Error GoTo RoundPenny_Error

         ' find decimal point
2        lngDecPos = InStr(1, strCurrency, ".")

         ' if there is a decimal point
3        If lngDecPos > 0 Then

            ' take everything before decimal as dollars
4           mnyDollars = CCur(Mid(strCurrency, 1, lngDecPos - 1))

            ' get amount after decimal point and multiply by 100 so cents is before decimal point
5           decRight = CDec(CDec(Mid(strCurrency, lngDecPos)) / 0.01)

            ' get cents by getting integer portion
6           decCents = Int(decRight)

            ' get leftover
7           decRight = CDec(decRight - decCents)

            ' if leftover is equal to or above round threshold
8           If decRight >= 0.5 Then

9              RoundPenny = mnyDollars + ((decCents + 1) * 0.01)

            ' if leftover is less than round threshold
10          Else

11             RoundPenny = mnyDollars + (decCents * 0.01)

12          End If

         ' if there is no decimal point
13       Else

            ' return it
14          RoundPenny = CCur(strCurrency)

15       End If

16       Exit Function

RoundPenny_Error:

17       Select Case Err.Number

            Case 6

18             Err.Raise vbObjectError + 334, c_strComponent & ".RoundPenny", "Number '" & strCurrency & "' is too big to represent as a currency value."

19          Case Else

20             DisplayError c_strComponent, "RoundPenny"

21       End Select

End Function
' ----------------------------------------------------------------------------- 
VBA.Round(1.23342, 2) // will return 1.23

Para resolver el problema de las divisiones de centavo que no se suman a la cantidad de la que se dividieron originalmente, creé una función definida por el usuario.

Function PennySplitR(amount As Double, Optional splitRange As Variant, Optional index As Integer = 0, Optional n As Integer = 0, Optional flip As Boolean = False) As Double
' This Excel function takes either a range or an index to calculate how to "evenly" split up dollar amounts
' when each split amount must be in pennies.  The amounts might vary by a penny but the total of all the
' splits will add up to the input amount.

' Splits a dollar amount up either over a range or by index
' Example for passing a range: set range $I$18:$K$21 to =PennySplitR($E$15,$I$18:$K$21) where $E$15 is the amount and $I$18:$K$21 is the range
'                              it is intended that the element calling this function will be in the range
' or to use an index and total items instead of a range: =PennySplitR($E$15,,index,N)
' The flip argument is to swap rows and columns in calculating the index for the element in the range.

' Thanks to: http://stackoverflow.com/questions/5559279/excel-cell-from-which-a-function-is-called for the application.caller.row hint.
Dim evenSplit As Double, spCols As Integer, spRows As Integer
If (index = 0 Or n = 0) Then
    spRows = splitRange.Rows.count
    spCols = splitRange.Columns.count
    n = spCols * spRows
    If (flip = False) Then
       index = (Application.Caller.Row - splitRange.Cells.Row) * spCols + Application.Caller.Column - splitRange.Cells.Column + 1
     Else
       index = (Application.Caller.Column - splitRange.Cells.Column) * spRows + Application.Caller.Row - splitRange.Cells.Row + 1
    End If
 End If
 If (n < 1) Then
    PennySplitR = 0
    Return
 Else
    evenSplit = amount / n
    If (index = 1) Then
            PennySplitR = Round(evenSplit, 2)
        Else
            PennySplitR = Round(evenSplit * index, 2) - Round(evenSplit * (index - 1), 2)
    End If
End If
End Function

Utilicé la siguiente función simple para redondear mis monedas como en nuestra empresa siempre redondeamos.

Function RoundUp(Number As Variant)
   RoundUp = Int(-100 * Number) / -100
   If Round(Number, 2) = Number Then RoundUp = Number
End Function

pero esto SIEMPRE redondeará hasta 2 decimales y también puede dar error.

incluso si es negativo, se redondeará (-1.011 será -1.01 y 1.011 será 1.02)

para proporcionar más opciones para redondear hacia arriba (o hacia abajo para negativo) podría usar esta función:

Function RoundUp(Number As Variant, Optional RoundDownIfNegative As Boolean = False)
On Error GoTo err
If Number = 0 Then
err:
    RoundUp = 0
ElseIf RoundDownIfNegative And Number < 0 Then
    RoundUp = -1 * Int(-100 * (-1 * Number)) / -100
Else
    RoundUp = Int(-100 * Number) / -100
End If
If Round(Number, 2) = Number Then RoundUp = Number
End Function

(usado en un módulo, si no es obvio)

Aquí hay una manera fácil de redondear siempre al siguiente número entero en Access 2003:

BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)

Por ejemplo:

  • [Peso] = 5.33; Int ([Peso]) = 5; entonces 5.33-5 = 0.33 (< > 0), entonces la respuesta es BillWt = 5 + 1 = 6.
  • [Peso] = 6,000, Int ([Peso]) = 6, entonces 6,000-6 = 0, entonces la respuesta es BillWt = 6.
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top