vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB4, VB5, VB606.10.04
Betragseingaben runden

Mit dieser Funktion können Betragswerte auf- oder abgerundet werden.

Autor:   Andreas KoopmannBewertung:  Views:  18.887 
ohne HomepageSystem:  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



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
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.