Mit der Funktion roundCast() kann man schnell und einfach Währungsrundungen durchführen. Klassisches Beispiel ist die 5-Rappen-Rundung in der Schweiz. Auch andere Rundungen mit einer Genaugkeit lasen sich druchführen.

Download cast_roundcurr.bas (V-1.1.0)

roundedValue = roundCurr(value, precision [,roundType])

roundCurr(ByVal iValue As Double, ByVal iPrecision As Double, Optional ByVal iRoundType As rcRoundType = rcRound) As Double

• iValue Wert der gerundet werde soll
• iPrecision Genauigkeit. Achtung: Ist nicht die Anzahl Nachkommastellen. Auf ganze Zahlen Runden ist also nicht 0 sondern 1 (siehe Beispiele)
• iRoundType Art wie gerundet werden soll. Siehe Enum rcRoundType

'/**
' * Type, wie die Funktion roundCurr() arbeiten soll. Normal runden, Aufrunden, Abrunden
' */
Public Enum rcRoundType
    rcRound     '0 Normal runden                          roundCurr(3.6, 0.5) = 3.5
    rcHalfDown  '1 Alias zu normal. 0.5 wird abgerundet   roundCurr(3.25, 0.5, rcHalfDown) = 3
    rcHalfUp    '2 Ab der Hälfte aufrunden                roundCurr(3.25, 0.5, rcHalfUp) = 3.5
    rcDowwn     '3 immer abrunden                         roundCurr(3.4, 0.5, rcDowwn) = 3
    rcUp        '4 immer aufrunden                        roundCurr(3.1, 0.5, rcUp) = 3.5
End Enum

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
d roundCurr(123.13, 1)
<Double> 123
 
'auf 25 Rappen runden
d roundCurr(123.13, 0.25)
<Double> 123.25
 
'auf 50 Franken runden
d roundCurr(123.13, 50)
<Double> 100

Auf/Abrunden

'Normal runden                          
d roundCurr(3.6, 0.5) 
<Double> 3.5
 
'Alias zu normal. 0.5 wird abgerundet   
d roundCurr(3.25, 0.5, rcHalfDown) 
<Double> 3
 
'Ab der Hälfte aufrunden                
d roundCurr(3.25, 0.5, rcHalfUp) 
<Double> 3.5
 
'immer abrunden                         
d roundCurr(3.4, 0.5, rcDowwn) 
<Double> 3
 
'immer aufrunden                        
d roundCurr(3.1, 0.5, rcUp) 
<Double> 3.5

Code zum importieren. Wenn er mit C&P in ein neus Modul eingefügt wird, dann muss die Zeile Attribute VB_Name = “cast_roundCurr” entfernt werden.

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