Come arrotondare in MS Access, VBA

StackOverflow https://stackoverflow.com/questions/137114

Domanda

Qual è il modo migliore per arrotondare in VBA Access?

Il mio metodo attuale utilizza il metodo Excel 

Excel.WorksheetFunction.Round(...

Ma sto cercando un mezzo che non si basi su Excel.

È stato utile?

Soluzione

Fai attenzione, la funzione VBA Round utilizza l'arrotondamento di Banker, dove arrotonda 0,5 a un numero pari, in questo modo: 

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)

Considerando che la funzione del foglio di lavoro Excel è arrotondata, arrotonda sempre 0,5 in su.

Ho fatto alcuni test e sembra che l'arrotondamento .5 (arrotondamento simmetrico) sia utilizzato anche per la formattazione delle celle e anche per l'arrotondamento della larghezza della colonna (quando si utilizza il formato Numero generale). Il flag "Precisione visualizzata" non sembra effettuare alcun arrotondamento, ma utilizza solo il risultato arrotondato del formato della cella.

Ho provato a implementare la funzione SymArith di Microsoft in VBA per il mio arrotondamento, ma ho scoperto che Fix ha un errore quando si tenta di assegnargli un numero come 58.55; la funzione che dà un risultato di 58.5 anziché 58.6. Alla fine ho scoperto che è possibile utilizzare la funzione Round foglio di lavoro Excel, in questo modo:

  

Application.Round (58.55, 1)

Ciò ti consentirà di eseguire l'arrotondamento normale in VBA, anche se potrebbe non essere veloce come una funzione personalizzata. Mi rendo conto che questo è tornato al punto di partenza della domanda, ma volevo includerlo per completezza.

Altri suggerimenti

Per espandere leggermente la risposta accettata:

" La funzione Round funziona da rotonda a pari, che è diversa da rotonda a più grande. "
--Microsoft

Il formato viene sempre arrotondato per eccesso. 

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

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

ACC2000: errori di arrotondamento quando si utilizzano numeri in virgola mobile: http://support.microsoft.com/ kb / 210423

ACC2000: Come arrotondare un numero verso l'alto o verso il basso di un incremento desiderato: http://support.microsoft .com / kb / 209996

Funzione rotonda: http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx

Come implementare le procedure di arrotondamento personalizzate: http://support.microsoft.com/kb/196652

In Svizzera e in particolare nel settore assicurativo, dobbiamo usare diverse regole di arrotondamento, a seconda che si verifichino, una prestazione ecc.

Attualmente utilizzo la funzione 

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

che sembra funzionare bene

Int e Fix sono entrambe utili funzioni di arrotondamento, che ti danno la parte intera di un numero.

Int arrotonda sempre per difetto - Int (3.5) = 3, Int (-3.5) = -4

La correzione viene sempre arrotondata allo zero - Correzione (3.5) = 3, Correzione (-3.5) = -3

Esistono anche le funzioni di coercizione, in particolare CInt e CLng, che tentano di forzare un numero in un tipo intero o lungo (gli interi sono compresi tra -32.768 e 32.767, i long sono compresi tra-2.147.483.648 e 2.147.483.647). Entrambi arrotonderanno verso il numero intero più vicino, arrotondando per difetto da zero a 0,5 - CInt (3,5) = 4, Cint (3,49) = 3, CInt (-3,5) = -4, ecc. 

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

e così via. Scoprirai spesso che soluzioni apparentemente complicate come questa sono molto più veloci rispetto all'utilizzo delle funzioni di Excel, perché VBA sembra funzionare in uno spazio di memoria diverso.

ad es. If A > B Then MaxAB = A Else MaxAB = B è circa 40 volte più veloce rispetto all'utilizzo di ExcelWorksheetFunction.Max

Sfortunatamente, le funzioni native di VBA che possono eseguire l'arrotondamento sono mancanti, limitate, imprecise o errate e ciascuna indirizza solo un singolo metodo di arrotondamento. Il lato positivo è che sono veloci e che in alcune situazioni può essere importante.

Tuttavia, spesso la precisione è obbligatoria, e con la velocità dei computer di oggi, difficilmente si noterà un'elaborazione leggermente più lenta, anzi non per l'elaborazione di singoli valori. Tutte le funzioni ai collegamenti sottostanti funzionano a circa 1 & # 181; s.

Il set completo di funzioni - per tutti i metodi di arrotondamento comuni, tutti i tipi di dati di VBA, per qualsiasi valore e non restituisce valori imprevisti - è disponibile qui:

Arrotondamento dei valori su, giù, di 4/5 o su cifre significative (EE)

o qui:

Arrotondamento dei valori, verso il basso, di 4/5, oppure a cifre significative (CodePlex)

Codice solo su GitHub:

VBA.Round

Coprono i normali metodi di arrotondamento:

  • Arrotondare per difetto, con l'opzione per arrotondare i valori negativi verso zero

  • Arrotondamento per eccesso, con l'opzione per arrotondare i valori negativi a zero

  • Round di 4/5, lontano da zero o pari (Rounding del banco)

  • Arrotonda a un conteggio di cifre significative

Le prime tre funzioni accettano tutti i tipi di dati numerici, mentre l'ultima esiste in tre varietà: rispettivamente per Valuta, Decimale e Doppio.

Accettano tutti un numero specifico di decimali, incluso un conteggio negativo che arrotonderà a decine, centinaia, ecc. Quelli con Variant come tipo di ritorno restituiranno Null per input incomprensibili

È incluso anche un modulo di test per test e validazione.

Un esempio è qui - per il comune arrotondamento 4/5. Si prega di studiare i commenti in linea per i dettagli sottili e il modo in cui CDec viene utilizzato per evitare errori di bit. 

' 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

Se stai parlando dell'arrotondamento a un valore intero (e non dell'arrotondamento di n decimali), c'è sempre la vecchia maniera: 

return int(var + 0.5)

(Puoi farlo funzionare anche per n decimali, ma inizia a diventare un po 'confuso)

Lance ha già menzionato l'arrotondamento ereditario bug nell'implementazione di VBA. Quindi ho bisogno di una vera funzione di arrotondamento in un'app VB6. Eccone uno che sto usando. Si basa su uno che ho trovato sul web come indicato nei commenti. 

' -----------------------------------------------------------------------------
' 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

Per risolvere il problema delle divisioni in penny che non si sommano all'importo da cui erano originariamente divise, ho creato una funzione definita dall'utente. 

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

Ho usato la seguente semplice funzione per arrotondare le mie valute come nella nostra azienda abbiamo sempre arrotondato per eccesso. 

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

ma questo arrotonderà SEMPRE fino a 2 decimali e potrebbe anche causare errori.

anche se è negativo arrotonderà per eccesso (-1,011 sarà -1,01 e 1,011 sarà 1,02)

in modo da fornire più opzioni per arrotondamento per eccesso (o per negativo per) che potresti utilizzare questa funzione: 

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

(usato in un modulo, se non è ovvio)

Ecco un modo semplice per arrotondare sempre al prossimo numero intero in Access 2003: 

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

Ad esempio:

  • [Peso] = 5,33; Int ([Peso]) = 5; quindi 5,33-5 = 0,33 (< > 0), quindi la risposta è BillWt = 5 + 1 = 6.
  • [Peso] = 6.000, Int ([Peso]) = 6, quindi 6.000-6 = 0, quindi la risposta è BillWt = 6.
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top