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.
roundedValue = roundCurr(value, precision [,roundType])
roundCurr(ByVal iValue As Double, ByVal iPrecision As Double, Optional ByVal iRoundType As rcRoundType = rcRound) As Double
'/** ' * 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.
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 hinzugefgt '------------------------------------------------------------------------------- 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 Hlfte 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 '/** ' * Whrungsrunden. 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