Zlonamernici ne znaju matematiku, i tu se nista ne moze. Mozda da probas nekom od ovih funkcija. Prva je verovatno dobra za decimalno zaokruzivanje, druga dozvoljava zaokruzivanje na koju hoces frakciju, a treca zaokruzuje na dole ili na gore, na koju hoces frakciju (na najblizi inch, na najblizih pola sata, na najblizih 0.25 i slicbne stvari)
Donje dve funkcije sam nekad davno (1997-1998) poslao u casopis VB Access Advisor, i objavili su ih, nakon je sam Veliki Ken Getz uradio neke popravke, tako da bi trebalo da rade :-)
Code:
Function Round_TSB(dblNumber As Double, intDecimals As Integer) As Double
'*******************************************
'Name: Round_TSB (Function)
'Purpose: round numbers, better than VBA does
'Author: Copied from ToatlAccessSource web site
'Date: December 14, 1999, 03:39:04 PM
'Called by:
'Calls:
'Inputs:
'Output:
'*******************************************
Dim dblFactor As Double
Dim dblTemp As Double
dblFactor = 10 ^ intDecimals
dblTemp = dblNumber * dblFactor + 0.5
'Round_TSB = Int("" & dblTemp) / dblFactor ' for 2.0 version
Round_TSB = Int(CDec(dblTemp)) / dblFactor
End Function
Code:
Function RoundNear(varNumber As Variant, varDelta As Variant) As Variant
'*******************************************
'Name: RoundNear (Function)
'Purpose: rounds varnumber to the nearest fraction equal varDelta
'Inputs: varNumber - number to round
' varDelta - the fraction used as measure of rounding
'Example: RoundNear(53,6) = 54, 54 is nearest multiply of 6
' RoundNear(1.16,0.25) = 1.25, 1.25 is the nearest multiply of 0.25
' RoundNear(1.12,0.25) = 1.00, 1.00 is the enarest multiply of 0.25
' RoundNear(1.125,0.25)= 1.25, 1.25 is the nearest multiply of 0.25
'Output:
'*******************************************
Dim varDec As Variant
Dim intX As Integer
Dim varX As Variant
'VarDelta must be <>0
On Error GoTo RoundNear_Error
If varDelta = 0 Then varDelta = 1
varX = varNumber / varDelta
intX = Int(varX)
varDec = CDec(varX) - intX
If varDec >= 0.5 Then
RoundNear = varDelta * (intX + 1)
Else
RoundNear = varDelta * intX
End If
On Error GoTo 0
Exit Function
RoundNear_Error:
MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure RoundNear of Module mod_Utils"
End Function
Code:
Function RoundUpDown(varNumber As Variant, varDelta As Variant) As Variant
'*******************************************
'Name: RoundDelta (Function)
'Purpose: round varNumber to varDelta, up or down
'Inputs: varNumber = number to round
' varDelta = rounding precission
' +varDelta = rounds UP
' -varDelta = rounds DOWN
'Example: RoundUpDown(5.12,+0.25) = 5.25
' RoundUpDown(5.12,-0.25) = 5.00
'Output: varNumber rounded UP/DOWN
'*******************************************
Dim varTemp As Variant
'VarDelta must be <>0
On Error GoTo RoundUpDown_Error
If varDelta = 0 Then varDelta = 1
varTemp = CDec(varNumber / varDelta)
If Int(varTemp) = varTemp Then
RoundUpDown = varNumber
Else
RoundUpDown = Int(((varNumber + varDelta) + varDelta) / varDelta - 1) * varDelta
End If
RoundUpDown_Exit_Here:
On Error GoTo 0
Exit Function
RoundUpDown_Error:
MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure RoundUpDown of Module mod_Utils"
Resume RoundUpDown_Exit_Here
End Function