DK-Flag Erik Østergaard - Source code snippets / Kildekode småstykker Go to Home Page
 (Geometric Shapes) Source code snippets Return
  
  
Bottom of This Page

 

Basic & VBA

- source code snippets /
- kildekode småstykker

Education

 


(Geometric Shapes) BASIC source code snippets BASIC (Beginner's All-purpose Symbolic Instruction Code) source code snippets / BASIC (Beginner's All-purpose Symbolic Instruction Code) kildekode småstykker

- included the programming languages variants: Basic, VB (Visual Basic), VBA (Visual Basic for Applications), and VBS (VBScript). / - inkluderet programmeringssprog varianterne: Basic, VB (Visual Basic), VBA (Visual Basic for Applications) og VBS (VBScript).

Warning Warning / AdvarselWarning: Don't run the script files without reading them first! /
Warning / AdvarselAdvarsel: Kør ikke script-filerne uden at læse dem først!

Basic & VBA - source code snippets / Basic & VBA - kildekode småstykker

Round an amount off to divisible by 0.25 & Round an amount off to divisible by 0.50 / Afrund et beløb til deleligt med 0,25 & Afrund et beløb til deleligt med 0,50

Description: Round Off to 'period twenty-five' floating-point number. Rounds an amount off to divisible by 0.25 DKK. & Round Off to 'period fifty' floating-point number. Rounds an amount off to divisible by 0.50 DKK. / Beskrivelse: Afrund til 'komma femogtyve' flydende decimaltal. Afrunder et beløb til deleligt med 0,25 kr. & Afrund til 'komma halvtreds' flydende decimaltal. Afrunder et beløb til deleligt med 0,50 kr.

Developed and tested under OpenOffice.org 2.3: Calc - Danish version & Microsoft Office Excel 2003 - English version. / Udviklet og testet under OpenOffice.org 2.3: Calc - dansk version & Microsoft Office Excel 2003 - engelsk version.

1 Implementation: (How to use:) Just paste the following code in a general module in your project: /
1 Implementering: (Sådan bruger du:) Bare indsæt følgende kode i et generelt modul i dit projekt:



' All variables must be declared before use.
Option Explicit

Public Function dkoereafrund(beloeb As Double) As Double
' Round Off to 'period twenty-five' floating-point number.
' Rounds an amount off to divisible by 0.25 DKK.
' Afrund til 'komma femogtyve' flydende decimaltal.
' Afrunder et beloeb til deleligt med 0,25 kr.

Dim afrbeloeb As Double
Dim resttal As Integer
Dim resultatbeloeb As Double

If IsNumeric(beloeb) Then

  ' Correction of small value errors.
  If beloeb <= 0.124 And beloeb >= -0.124 Then
    resultatbeloeb = 0
    ' Return result.
    dkoereafrund = resultatbeloeb
    Exit Function
  End If
  
  ' Rounds a given number to a specified number of decimal places
  ' follow standard rules for rounding. That is, if the digit in
  ' the position to the right of decimalplaces is 6 or greater, the
  ' digit in the decimalplaces position is incremented by 1; if 5,
  ' it becomes the nearest even number; otherwise, the digits to
  ' the right of the decimalplaces are dropped. Format will use
  ' the same format as that defined for positive values on negative
  ' values, meaning that negative values will appear in the same
  ' format as positive values.
  afrbeloeb = CDbl(Format(beloeb, "#.##"))

  ' The modulo operator. Performs division on two numeric
  ' expressions and returns only the remainder. If either of the
  ' two numbers is a floating-point number, it's rounded to an
  ' integer value prior to the modulo operation.
  resttal = (afrbeloeb * 100) Mod 25
  
  If afrbeloeb >= 0 Then
    ' Positive values.
    If resttal >= 12.5 Then
      ' Range +13 to +24.
      resultatbeloeb = afrbeloeb + ((25 - resttal) / 100)
    Else
      ' Range +0 to +12.
      resultatbeloeb = afrbeloeb - ((resttal) / 100)
    End If
  Else
    ' Negative values.
    If resttal >= -12.5 Then
      ' Range -1 to -12.
      resultatbeloeb = afrbeloeb - ((resttal) / 100)
    Else
      ' Range -13 to -24.
      resultatbeloeb = afrbeloeb + ((-25 - resttal) / 100)
    End If
  End If

  ' Return result.
  dkoereafrund = resultatbeloeb

End If

End Function

Public Function dkoereafrund5(beloeb As Double) As Double
' Round Off to 'period fifty' floating-point number.
' Rounds an amount off to divisible by 0.50 DKK.
' Afrund til 'komma halvtreds' flydende decimaltal.
' Afrunder et beloeb til deleligt med 0,50 kr.

Dim afrbeloeb As Double
Dim resttal As Integer
Dim resultatbeloeb As Double

If IsNumeric(beloeb) Then

  ' Correction of small value errors.
  If beloeb <= 0.254 And beloeb >= -0.254 Then
    resultatbeloeb = 0
    ' Return result.
    dkoereafrund5 = resultatbeloeb
    Exit Function
  End If
  
  ' Rounds a given number to a specified number of decimal places
  ' follow standard rules for rounding. That is, if the digit in
  ' the position to the right of decimalplaces is 6 or greater, the
  ' digit in the decimalplaces position is incremented by 1; if 5,
  ' it becomes the nearest even number; otherwise, the digits to
  ' the right of the decimalplaces are dropped. Format will use
  ' the same format as that defined for positive values on negative
  ' values, meaning that negative values will appear in the same
  ' format as positive values.
  afrbeloeb = CDbl(Format(beloeb, "#.##"))

  ' The modulo operator. Performs division on two numeric
  ' expressions and returns only the remainder. If either of the
  ' two numbers is a floating-point number, it's rounded to an
  ' integer value prior to the modulo operation.
  resttal = (afrbeloeb * 100) Mod 50
  
  If afrbeloeb >= 0 Then
    ' Positive values.
    If resttal >= 25.5 Then
      ' Range +26 to +49.
      resultatbeloeb = afrbeloeb + ((50 - resttal) / 100)
    Else
      ' Range +0 to +25.
      resultatbeloeb = afrbeloeb - ((resttal) / 100)
    End If
  Else
    ' Negative values.
    If resttal >= -25.5 Then
      ' Range -1 to -25.
      resultatbeloeb = afrbeloeb - ((resttal) / 100)
    Else
      ' Range -26 to -49.
      resultatbeloeb = afrbeloeb + ((-50 - resttal) / 100)
    End If
  End If

  ' Return result.
  dkoereafrund5 = resultatbeloeb

End If

End Function

Conventions used for: Source code syntax highlighting. / Regler brugt til: Kildekode syntaks fremhævning.

2 Implementation: (How to use:) Now you can call the function dkoereafrund(your_floating-point_number_goes_here) or dkoereafrund5(your_floating-point_number_goes_here) from your project. /
2 Implementering: (Sådan bruger du:) Nu kan du kalde funktionen dkoereafrund(dit_flydende_decimaltal_indsaettes_her) eller dkoereafrund5(dit_flydende_decimaltal_indsaettes_her) fra dit projekt.

or... / eller...

You can download a version of the source code from my Download page here: / Du kan downloade en version af kildekoden fra min Download side her:

[Basic] Download Round an amount off to divisible by 0.25: oereafr.zip & [Basic] Download Round an amount off to divisible by 0.50: oereafr5.zip / [Basic] Download Afrund et beløb til deleligt med 0,25: oereafr.zip & [Basic] Download Afrund et beløb til deleligt med 0,50: oereafr5.zipOpen this link in new window / Åben dette link i nyt vindue

or... / eller...

See similar source code for JavaScript here: / Se tilsvarende kildekode for JavaScript her:

Round an amount off to divisible by 0.25 & Round an amount off to divisible by 0.50 / Afrund et beløb til deleligt med 0,25 & Afrund et beløb til deleligt med 0,50


(Geometric Shapes) Source code snippetsSource code snippets / Kildekode småstykker

- often included as functions for use in modules with program code, macros, and scripts etcetera. / - mange gange inkluderet som funktioner til brug i moduler med programkode, makroer og scripts og så videre.

The code might need some minor tweaks to run in your application. / Koden kan behøve nogle mindre ændringer for at kunne afvikles i dit anvendelsesområde.

Warning / Advarsel Licence: Free to use, but please share improvements. No warranty - use at own risk. /
Warning / Advarsel Licens: Fri brug, men del venligst forbedringer. Ingen garanti - brug på eget ansvar.

Warning: Don't run the script files without reading them first!
Total absence of any guarantee, warranty, or responsibility for script files, the script(s), the files they may produce, or the effects the script(s) or script-produced files may have. The script(s) is, after all, plain text. The burden is on the person using the script(s) to examine the script source code and determine whether or not a script is usable and safe. Operating systems and browsers are constantly changing. What works today may not work tomorrow!

Advarsel: Kør ikke script-filerne uden at læse dem først!
Totalt fravær af nogen form for garanti, garanti eller ansvar for script-filer, scriptet(scriptene), de filer, de kan producere eller de virkninger, scriptet(scriptene) eller scriptproducerede filer kan have. Scriptet(Scriptene) er, trods alt, almindelig tekst. Byrden er på brugeren af scriptet(scriptene) til at undersøge script kildekoden og afgøre, hvorvidt et script er brugbart og sikkert. Operativsystemer og browsere er under konstant forandring. Hvad fungerer i dag, fungerer muligvis ikke i morgen!


   Top of This Page
   Return
   Go to Home Page