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 Dieser Tipp wurde bereits 19.008 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! Tipp des Monats November 2024 Dieter Otter WAVE-Dateien aufnehmen Ein Code-Ausschnitt, mit dem sich WAVE-Dateien in verschiedenen Aufnahmequalitäten aufnehmen lassen. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |