This is an old revision of the document!
Mit der Funktion roundCast() kann man schnell und einfach Währungsrundungen durchführen. Klassisches Beispiel ist die 5-Rappen-Rundung in der Schweiz.
Double = cValue(Double [,Double])
roundCurr(ByVal iValue As Double, ByVal iPrecision As Double) As Double
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
Code
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