Betragseingaben runden Mit dieser Funktion können Betragswerte auf- oder abgerundet werden.
Autor:   Andreas Koopmann	Bewertung:	Views:  18.833
ohne Homepage	System:  Win9x, WinNT, Win2k, Win8, Win10, Win11	Beispielprojekt auf CD

Wenn ein Betrag gerundet werden soll, so ist die folgende Funktion vielleicht eine Hilfe, da sie sowohl auf-, als auch abrunden kann. Die Parameter und die Funktionsweise werden in den Kommentaren erklärt.

Die Funktion rundet auf den nächstmöglichen (Cent-)Wert nach oben oder unten. Hierbei werden nur Beträge gebildet, die auf den Parameter "lWert" enden. Dies wird z.B. dann benötigt, um Preise nach einer Rabattvergabe zu korrigieren.

' ------------------------------------------------------------------
'   Funktion :  Runden
' 
'   Vorauss. : -
' 
'   Parameter: dBetrag As Double
'              (der zu rundende Betrag in Euro)
'   Parameter: lWert As Long
'              (der Wert, um den gerundet werden soll in Cent)
' 
'              ein positiver Wert bedeutet,
'              es soll aufgerundet werden
' 
'              ein negativer Wert bedeutet,
'              es soll abgerundet werden
' 
' 
'    Rückgabe: der gerundete Betrag als double
' 
'       Autor:  A.Koopmann 01.10.2004
' ------------------------------------------------------------------
Private Function Runden(dBetrag As Double, lWert As Long) As Double
  Dim lDiff As Long
  Dim lGerundet As Long
  Dim lWaehrungsteiler As Long
  Dim sWaehrungsformat As String
 
  ' Hier wird angegeben, wieviel Cent einen Euro ergeben.
  ' In Kuwait steht hier z.B. 1000 da 1 Dinar=1000 fils
  lWaehrungsteiler = 100
 
  ' zunächst gehen wir davon aus, dass nicht gerundet werden
  ' muss -> der gerundete Betrag ist der Originalbetrag
  ' den übergebenen Betrag gleichzeitig in einen long-Wert bringen.
  lGerundet = CLng(Format(dBetrag * lWaehrungsteiler, "0"))
 
  If lWert = 0 Then
    ' Es soll nicht gerundet werden
  Else
    ' Die Rundungsdifferenz ermitteln
    lDiff = lGerundet Mod lWert
 
    If lDiff = Abs(lWert) Or lDiff = 0 Then
      ' Der Betrag steht schon auf einem Wert, bei dem nicht gerundet
      ' werden muss oder die Rundungsdifferenz ist 0
      ' -> es muss nicht gerundet werden.
    Else
      If lWert > 0 Then
        ' Es soll aufgerundet werden. Es wird erstmal der zu rundende
        ' Wert dem Ursprungsbetrag zugeschlagen.
        lGerundet = lGerundet + lWert
      End If
      ' Jetzt endlich kann die Rundungsdifferenz abgezogen werden.
      lGerundet = lGerundet - lDiff
    End If
  End If
 
  ' Einen string zusammenstellen, der das Format der
  ' verwendeten Währung darstellt.
  sWaehrungsformat = Replace(CStr(lWaehrungsteiler), "1", "0.")
 
  ' Den gerundeten Betrag wieder in einen double-Wert
  ' bringen der der Währung entspricht.
  Runden = CDbl(Format(lGerundet / lWaehrungsteiler, sWaehrungsformat))
End Function

Ein paar Anwendungsbeispiel:

1. Ein Preis soll auf einen Wert gebracht werden, der auf 5 Cent endet. Hierbei soll aufgerundet werden.

Wert = Runden(13.79, 5) ' ergibt 13.80

2. Das gleiche mit abgerundetem Wert:

Wert = Runden(13.79, -5) ' ergibt 13.75

3. Ein Preis soll auf den nächsten 50 Cent-Wert aufgerundet werden:

Wert = Runden(13.79, 50) ' ergibt 14.00

4. Das gleiche mit abgerundetem Wert:

Wert = Runden(13.79, -50) ' ergibt 13.50

5. Ein Preis soll auf den nächsten Euro-Wert aufgerundet werden:

Wert = Runden(13.79, 100) ' ergibt 14.00

6. Das gleiche mit abgerundetem Wert:

Wert = Runden(13.79, -100) ' ergibt 13.00

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.