So runden Sie in MS Access, VBA

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

Frage

Was ist der beste Weg, in VBA Access zu runden?

Meine aktuelle Methode verwendet die Excel-Methode

Excel.WorksheetFunction.Round(...

Aber ich suche nach einem Mittel, das nicht auf Excel angewiesen ist.

War es hilfreich?

Lösung

Seien Sie vorsichtig, die VBA Round-Funktion verwendet Bankers Runden, wo es 0,5 auf eine gerade Zahl rundet, etwa so: 

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)

Während der Excel-Tabellenfunktion Runde, immer rundet 0,5 auf.

Ich habe einige Tests gemacht und es sieht aus wie 0,5 bis Rundung (symmetrische Rundung) auch durch Zellformatierung verwendet wird, und auch für die Spaltenbreite Rundung (wenn das Zahlenformat verwenden). Die ‚Genauigkeit wie angezeigt‘ Flag scheint keine Rundung selbst zu tun, es nutzt nur das abgerundete Ergebnis des Zellenformat.

Ich habe versucht, die SymArith Funktion von Microsoft in VBA für meine Runden zu implementieren, aber festgestellt, dass Fix einen Fehler hat, wenn Sie versuchen, es zu geben, eine Zahl wie 58,55; die Funktion ein Ergebnis von 58,5 statt 58,6 geben. Ich habe dann entdeckt schließlich, dass Sie die Excel-Arbeitsblatt-Round-Funktion verwenden können, etwa so:

  

Application.Round (58,55, 1)

Dies ermöglicht es Ihnen normale Rundung in VBA zu tun, obwohl es nicht so schnell wie einige benutzerdefinierte Funktion sein kann. Mir ist klar, dass dieser Kreis von der Frage gekommen ist, aber wollte es der Vollständigkeit halber enthalten.

Andere Tipps

Um ein wenig auf der akzeptierte Antwort zu erweitern:

"Die Round-Funktion führt Runde sogar, die von Runde zu größeren unterscheidet."
--Microsoft

Format immer abrundet. 

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

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

ACC2000: Rundungsfehler bei Verwendung von Gleitkommazahlen: http://support.microsoft.com/ kb / 210423

ACC2000: eine Anzahl nach oben oder unten einem gewünschten Schritt Runde: http://support.microsoft .com / kb / 209996

Round Funktion: http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx

Wie Implementieren Benutzerdefinierte Rounding Procedures: http://support.microsoft.com/kb/196652

In der Schweiz und in particulat in der Versicherungsbranche, haben wir mehrere Rundungsregeln verwenden, je nachdem, ob es cHash aus, ein Vorteil etc.

ich zur Zeit verwenden Sie die Funktion 

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

, die gut zu funktionieren scheint,

Int und Fix sind beide nützlichen Rundungsfunktionen, die Ihnen den ganzzahligen Teil einer Zahl geben.

Int immer abrundet - Int (3,5) = 3, Int (-3,5) = -4

Fix rundet immer gegen Null - Fix (3,5) = 3, Fix (-3,5) = -3

Es gibt auch die Zwangsfunktionen, insbesondere CInt und CLng, die versuchen, eine Zahl in einem Integer-Typ oder eine Lang zu zwingen (ganze Zahlen sind zwischen 32.768 und 32.767, Long-Positionen sind zwischen-2147483648 und 2147483647). Diese werden sowohl runde auf die nächste ganze Zahl gerundet weg von Null von 0,5 - CInt (3.5) = 4, Cint (3,49) = 3, CInt (-3,5) = -4, usw.

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

und so on.You'll oft fest, dass scheinbar kludgy Lösungen wie diese viel schneller sind als Excel-Funktionen verwenden, da VBA in einem anderen Speicherplatz zu funktionieren scheint.

zB If A > B Then MaxAB = A Else MaxAB = B ist etwa 40 x schneller als ExcelWorksheetFunction.Max mit

Leider fehlen die nativen Funktionen von VBA, die Rundungen durchführen können, sind entweder eingeschränkt, ungenau oder fehlerhaft und behandeln jeweils nur eine einzige Rundungsmethode.Der Vorteil ist, dass sie schnell sind, und das kann in manchen Situationen wichtig sein.

Oftmals ist jedoch Präzision gefragt, und bei der heutigen Geschwindigkeit von Computern wird eine etwas langsamere Verarbeitung kaum noch auffallen, schon gar nicht bei der Verarbeitung einzelner Werte.Alle Funktionen unter den folgenden Links laufen mit ca. 1 µs.

Den kompletten Satz an Funktionen – für alle gängigen Rundungsmethoden, alle Datentypen von VBA, für jeden Wert und ohne die Rückgabe unerwarteter Werte – finden Sie hier:

Werte auf- oder abrunden, um 4/5 oder auf signifikante Zahlen (EE)

oder hier:

Werte auf- oder abrunden, um 4/5 oder auf signifikante Zahlen (CodePlex)

Code nur bei GitHub:

VBA.Runde

Sie decken die üblichen Rundungsmethoden ab:

  • Abrunden, mit der Option, negative Werte gegen Null zu runden

  • Aufrunden, mit der Option, negative Werte von Null aus abzurunden

  • Runden Sie um 4/5, entweder weg von Null oder gerade (Bankrundung)

  • Runden Sie auf eine Anzahl signifikanter Zahlen

Die ersten drei Funktionen akzeptieren alle numerischen Datentypen, während die letzte in drei Varianten existiert – für Währung, Dezimal und Double.

Sie alle akzeptieren eine bestimmte Anzahl von Dezimalstellen – einschließlich einer negativen Anzahl, die auf Zehner, Hunderter usw. gerundet wird.Diejenigen mit Variant als Rückgabetyp geben Null für unverständliche Eingaben zurück

Ein Testmodul zum Testen und Validieren ist ebenfalls enthalten.

Ein Beispiel finden Sie hier – für die übliche 4/5-Rundung.Bitte lesen Sie die Inline-Kommentare für die subtilen Details und die Vorgehensweise CDec wird verwendet, um Bitfehler zu vermeiden.

' 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

Wenn Sie sprechen auf einen ganzzahligen Wert gerundet (und nicht die Rundung auf n Dezimalstellen), gibt es immer die alte Schule Art und Weise: 

return int(var + 0.5)

(Sie können diese Arbeit machen für n Dezimalstellen auch, aber es beginnt ein bisschen chaotisch zu bekommen)

Lance erwähnt bereits das Vererben bug in VBA Implementierung Runden. Also muß ich eine echte Rundungsfunktion in einem VB6-App. Hier ist eine, die ich verwende. Es basiert auf den ich im Internet gefunden, wie in den Kommentaren angezeigt wird. 

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

das Problem der Penny zu lösen Splits Zugabe nicht bis zur Höhe, die sie ursprünglich aus geteilt wurden, habe ich eine benutzerdefinierte Funktion erstellt. 

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

Ich habe die folgende einfach Funktion meine abzurunden Währungen , wie in unserer Firma, die wir auf immer aufrunden. 

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

, aber das wird immer rund bis zu 2 Dezimalstellen und kann auch Fehler.

auch wenn sie negativ ist, wird es aufrunden (-1,011 -1,01 sein und 1.011 werden 1,02 sein)

so mehr Optionen bieten für Aufrundung (oder unten für negativ) Sie konnte Mit dieser Funktion können: 

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

(in einem Modul verwendet wird, wenn es nicht offensichtlich ist)

Dies ist einfache Möglichkeit, immer aufrunden nächste ganze Zahl in Access 2003: 

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

Zum Beispiel:

  • [Gewicht] = 5,33; Int ([Gewicht]) = 5; so 5,33-5 = 0,33 (<> 0), so Antwort ist BillWt = 5 + 1 = 6
  • [Gewicht] = 6,000, Int ([Gewicht]) = 6, so 6,000-6 = 0, so Antwort ist BillWt = 6.
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top