Mit der Funktion roundCast() kann man schnell und einfach Währungsrundungen durchführen. Klassisches Beispiel ist die 5-Rappen-Rundung in der Schweiz.

Download cast_roundcurr.bas (V-1.0.0)

Double = cValue(Double [,Double])

roundCurr(ByVal iValue As Double, ByVal iPrecision As Double) As Double

• iValue Wert der gerundet werde soll
• iPrecision Genauigkeit

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r().

'auf 5 Rappen genau: .12 wird abgerundet
d roundCurr(123.12, 0.05)
<Double> 123.1
 
'auf 5 Rappen genau: .13 wird aufgerundet
d roundCurr(123.13, 0.05)
<Double> 123.15
 
'auf 1 Franken runden.Achtung
d roundCurr(123.13, 1)
<Double> 123
 
'auf 25 Rappen runden
d roundCurr(123.13, 0.25)
<Double> 123.25

cast_roundcurr.bas

Attribute VB_Name = "cast_roundCurr"
'-------------------------------------------------------------------------------
'File         : cast_roundCurr.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/roundCurr
'Environment  : VBA 2007 +
'Version      : 1.1.0
'Name         : roundCurr
'Author       : Stefan Erb (ERS)
'History      : 05.01.2015 - ERS - Creation
'               24.08.2016 - ERS - Parameter iRoundType hinzugefügt
'-------------------------------------------------------------------------------
Option Explicit
 
' roundedValue = roundCurr(value, precision [,roundType])
 
'/**
' * Type, wie die Funktion roundCurr() arbeiten soll. Normal runden, Aufrunden, Abrunden
' */
Public Enum rcRoundType
    rcRound     'Normal runden                          roundCurr(3.6, 0.5) = 3.5
    rcHalfDown  'Alias zu normal. 0.5 wird abgerundet   roundCurr(3.25, 0.5, rcHalfDown) = 3
    rcHalfUp    'Ab der Hälfte aufrunden                roundCurr(3.25, 0.5, rcHalfUp) = 3.5
    rcDowwn     'immer abrunden                         roundCurr(3.4, 0.5, rcDowwn) = 3
    rcUp        'immer aufrunden                        roundCurr(3.1, 0.5, rcUp) = 3.5
End Enum
 
'/**
' * Währungsrunden. 5-Rappen Problem
' * @example    Runden auf 5 Rappen:    roundCurr(12.12, 0.05)
' *             Runden auf 1 Franken:   roundCurr(12.12, 1)
' *             Runden auf 25 Rappen:   roundCurr(12.12, 0.25)
' *             Runden auf 50 Franken:  roundCurr(1234.5, 50)
' * @param  Double      Wert der gerundet werde soll
' * @param  Double      Genauigkeit
' * @param  rcRoundType Art wie gerundet werden soll
' * @return Double      gerundeter Wert
' */
Public Function roundCurr(ByVal iValue As Double, ByVal iPrecision As Double, Optional ByVal iRoundType As rcRoundType = rcRound) As Double
    Const C_CORR = 0.000000001 '1E-9
    Select Case iRoundType
        Case rcHalfUp:  roundCurr = round((iValue / iPrecision) + C_CORR, 0) * iPrecision
        Case rcDowwn:   roundCurr = Fix(iValue / iPrecision) * iPrecision
        Case rcUp:      roundCurr = Fix((iValue / iPrecision) + 1 - C_CORR) * iPrecision
        Case Else:      roundCurr = round(iValue / iPrecision, 0) * iPrecision
    End Select
End Function