Tipp 10.7 - Runden

Wie kann ich eine Rundungsfunktion unter Berücksichtigung der Nachkommastellen einsetzen?

Mit dieser Funktion können Sie eine Rundungsfunktion unter Berücksichtigung der Nachkommastellen einsetzen. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Beispiel:

Option Explicit
 
Public Function vbRound(ByVal dblWert As Double, _
                        iStellen As Integer) As Double
'// --------------------------------------------------------
'// Methode:   | Rundungsfunktion unter Berücksichtigung
'//            | der Anzahl Nachkommastellen
'// --------------------------------------------------------
'// Parameter: | dblWert  - zu rundender Wert
'//            | iStellen - Anzahl Nachkommastellen
'// --------------------------------------------------------
'// Rückgabe:  | gerundeter Wert
'// --------------------------------------------------------
'// Beispiel:  |?vbRound(1254.4916, 3) - 1254,492
'//            |?vbRound(1254.4916, 2) - 1254,49
'//            |?vbRound(1254.4916, 1) - 1254,5
'// --------------------------------------------------------
'// Autor:     | Stefan Kulpa
'//            | EDV Innovation & Consulting - Dormagen
'// --------------------------------------------------------
    Dim dblExp As Double
    On Error GoTo MyErr
    Select Case iStellen
           Case 0: dblExp = 1
           Case 1: dblExp = 10
           Case 2: dblExp = 100
           Case 3: dblExp = 1000
           Case 4: dblExp = 10000
           Case 5: dblExp = 100000
           Case 6: dblExp = 1000000
           Case 7: dblExp = 10000000
           Case 8: dblExp = 100000000
           Case Else: GoTo MyErr
    End Select
    If dblWert >= 0 Then
        vbRound = _
        Int(dblWert * dblExp + 0.5000000001) / dblExp
    Else
        vbRound = _
        -(Int((-dblWert) * dblExp + 0.5000000001) / dblExp)
    End If
    Exit Function
 
MyErr:
    vbRound = 0#
 
End Function