Printable View
Hi
Has anyone got a function to email to me that rounds a floating point number to a certain number of decimal places.
The built in VB Round() function has bugs.
I read somewhere on this site that is you round 3.45 to 1 decimal place, it will make it 3.4 rather than 3.5
This is quite urgent, so please help.
Thanks!
write your own rounding function
Hope this helps.Code:Public Function MyRound(Number as Double,Optional NoDP as Integer = 0)
Dim strNumber as String
strNumber = cStr(Number) 'Convert number to string
If Right$(strNumber,1)="5" Then 'If number ends in a 5
MyRound = Round(cDbl(strNumber & "1"),NoDP)
Else
MyRound = Round(Number,NoDP)
End If
End Function
Or you could use the Format function, as follows:
Format(CDbl(Text1.Text), "0.00")
Most of the work I do requires mathematical values being rounded to all different formats. I usually do each one individually.
Where X is my value
Result = (Int((X)*100 + .499999))/100
would round to the nerest .01
that's the basic format. You can get decimal fractions too.
Result = (Int((X)* 4 )) / 4
round to nearest LOWEST 1/4
Hope this helps.
What I do find fifficult is working with angles.
My data is usually entered in as DD-MM-SS-. I can easily convert it into a decimal angle. But to then to convert back to DD-MM-SS-. Sometimes you end up with a value of 60 in the Seconds.
i didn't really test this to much, but it should work (i hope)
Code:Public Function trueRound(num As Double, numOfPlaces As Long) As Double
Dim x As Double, s As String
Dim decP As Long
s = CStr(num)
'find decimal
For x = 1 To Len(s)
If Mid$(s, x, 1) = "." Then
decP = x
End If
Next
'move the number after where you are rounding to and change it to 6
'to force the correct rounding
If Mid$(s, decP + numOfPlaces + 1, 1) = "5" Then
Mid(s, decP + numOfPlaces + 1, 1) = "6"
End If
num = CDbl(s)
'round as normal
x = Round(num, numOfPlaces)
trueRound = x
End Function
If you try rounding 0.5 by adding 0.4999999, you won't get the right answer. The function below will round to any number of decimal places (including negatives!), and will pass any errors back to the calling procedure.
I have also included a function to convert a decimal angle to D-M-S format, which catches the rounding errors that cause 60 to appear in the minutes or seconds. It will return a string representation, but you can use the optional parameters to return the individual parts (lngDeg, lngMin and dblSec). You can use the last parameter (lngSecDP) to specify the number of decimal places to round the seconds to.
Hope this helps:
Function Round(dblNumber As Double, _
Optional lngDP As Long = 0) As Double
Dim dblPW As Double
dblPW = 10 ^ lngDP
Round = Int((dblNumber * dblPW) + 0.5) / dblPW
End Function
Function Deg2DMS(dblDegrees As Double, _
Optional lngDeg As Long, _
Optional lngMin As Byte, _
Optional dblSec As Double, _
Optional lngSecDP As Long = 2) _
As String
Dim dblTemp As Double
Dim strFmt As String
dblTemp = dblDegrees
lngDeg = Int(dblTemp)
dblTemp = (dblTemp - lngDeg) * 60
lngMin = Int(dblTemp)
dblTemp = (dblTemp - lngMin) * 60
dblSec = dblTemp
If lngSecDP > 0 Then
strFmt = "00." & String$(lngSecDP, "0")
Else
strFmt = "00"
End If
If Round(dblSec, lngSecDP) = 60 Then
'Round up seconds
If lngMin = 59 Then
Deg2DMS = (lngDeg + 1) & Chr$(176) & _
" 00` " & Format$(0, strFmt) & "``"
Else
Deg2DMS = lngDeg & Chr$(176) & " " & _
Format$((lngMin + 1), "00") & _
"` " & Format$(0, strFmt) & "``"
End If
Else
Deg2DMS = lngDeg & Chr$(176) & " " & _
Format$(lngMin, "00") & "` " & _
Format$(dblSec, strFmt) & "``"
End If
End Function
Thanks a lot. The function and examples helped me out a lot.
The Round() function is *buggy* only if you do not now what it is for. The Round() function uses Banker's rounding, not Arithmetic rounding. Read article Q194983 from the Microsoft Knowledge Base:
"The Round() function in Visual Basic for Applications 6, uses Banker's rounding, which rounds .5 either up or down, whichever will result in an even number."
"STATUS
This behavior is by design."
Want the full spec's on why this is? Read: "Q196652 - HOWTO: Implement Custom Rounding Procedures" This gives you a comparison of different rounding algorithms.
Please research your *bugs* before letting the allegations fly or you will unjustly drag on VB's reputation of being *buggy*.
Thanks,
S. Kinyon
That's fasinating. I just read though the articles, the different rounding techniques look like this
FYI
Code:
Function AsymDown(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
AsymDown = Int(X * Factor) / Factor
End Function
Function SymDown(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
SymDown = Fix(X * Factor) / Factor
' Alternately:
' SymDown = AsymDown(Abs(X), Factor) * Sgn(X)
End Function
Function AsymUp(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
Dim Temp As Double
Temp = Int(X * Factor)
AsymUp = (Temp + IIf(X = Temp, 0, 1)) / Factor
End Function
Function SymUp(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
Dim Temp As Double
Temp = Fix(X * Factor)
SymUp = (Temp + IIf(X = Temp, 0, Sgn(X))) / Factor
End Function
Function AsymArith(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
AsymArith = Int(X * Factor + 0.5) / Factor
End Function
Function SymArith(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
SymArith = Fix(X * Factor + 0.5 * Sgn(X)) / Factor
' Alternately:
' SymArith = Abs(AsymArith(X, Factor)) * Sgn(X)
End Function
Function BRound(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
' For smaller numbers:
' BRound = CLng(X * Factor) / Factor
Dim Temp As Double, FixTemp As Double
Temp = X * Factor
FixTemp = Fix(Temp + 0.5 * Sgn(X))
' Handle rounding of .5 in a special manner
If Temp - Int(Temp) = 0.5 Then
If FixTemp / 2 <> Int(FixTemp / 2) Then ' Is Temp odd
' Reduce Magnitude by 1 to make even
FixTemp = FixTemp - Sgn(X)
End If
End If
BRound = FixTemp / Factor
End Function
Function RandRound(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
' Should Execute Randomize statement somewhere prior to calling.
Dim Temp As Double, FixTemp As Double
Temp = X * Factor
FixTemp = Fix(Temp + 0.5 * Sgn(X))
' Handle rounding of .5 in a special manner.
If Temp - Int(Temp) = 0.5 Then
' Reduce Magnitude by 1 in half the cases.
FixTemp = FixTemp - Int(Rnd * 2) * Sgn(X)
End If
RandRound = FixTemp / Factor
End Function
Function AltRound(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
Static fReduce As Boolean
Dim Temp As Double, FixTemp As Double
Temp = X * Factor
FixTemp = Fix(Temp + 0.5 * Sgn(X))
' Handle rounding of .5 in a special manner.
If Temp - Int(Temp) = 0.5 Then
' Alternate between rounding .5 down (negative) and up (positive).
If (fReduce And Sgn(X) = 1) Or (Not fReduce And Sgn(X) = -1) Then
' Or, replace the previous If statement with the following to
' alternate between rounding .5 to reduce magnitude and increase
' magnitude.
' If fReduce Then
FixTemp = FixTemp - Sgn(X)
End If
fReduce = Not fReduce
End If
AltRound = FixTemp / Factor
End Function
Function ADownDigits(ByVal X As Double, _
Optional ByVal Digits As Integer = 0) As Double
ADownDigits = AsymDown(X, 10 ^ Digits)
End Function
FAO Skinyon:
It actually says on this web site that the function is buggy. So complain to them, not me.
You could use the CInt function to round the number up as well. Except this function rounds it to the nearest whole number.
Code:MyVal = 1.7
MyNewVal = CInt(MyVal)
In which case use
CInt(MyVal - 0.5)