Afrunding af øre i access 2003

http://allenbrowne.com/round.html

Jeg har tidligere lavet nedenstående
Den er til afrunding i forbindelse med skatteberegning.
F.eks. giver fhpTAX_Rounding(275, 10, False) 270
Det er 275 afrundet til næmeste tier uden at runde op.
fhpTAX_Rounding(275, 10, True) giver 280
Det er 275 afrundet til næmeste tier rundet op.

Funktionen kan selvfølgelig nok pudses af, som du kan se er den lavet i 2002 :-)

Brug den hvis du har lyst

Public Function fhpTAX_Rounding(sngNumber As Single, sngRoundTo As Single, Optional bolRoundUp As Boolean) As Single
' -----------------------------------------------------------------------------------
' Purpose    : Afrunding af diverse tal
' Parameters :
' Returns    :
' Created    : 01-31-02
' Modified  :
' Remarks    :
' -----------------------------------------------------------------------------------
On Error GoTo Error_fhpTAX_Rounding
  Dim sngValue As Single                                              'Calculation
 
  If sngRoundTo = 0 Then                                              'If normal rounding
    sngValue = Round(sngNumber, 0)
    GoTo Exit_fhpTAX_Rounding
  End If
 
  sngValue = Int(sngNumber / sngRoundTo) * sngRoundTo
 
  If Abs(sngValue) < Abs(sngNumber) Then
    If bolRoundUp = True Then
      sngValue = sngValue + Val(sngRoundTo)
    End If
  End If

Exit_fhpTAX_Rounding:
  fhpTAX_Rounding = sngValue
  Exit Function
 
Error_fhpTAX_Rounding:
  Select Case Err.Number
    Case 11
      MsgBox "Afrunding til 0 er ikke muligt! ", vbCritical + vbOKOnly, "Fejl i data"
    Case 2501
    Case 3021
    Case Else
      MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'fhpTAX_Rounding'"
  End Select
  sngValue = 0                                                          'Fejl i afrunding
  Resume Exit_fhpTAX_Rounding
 
End Function