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