by Filipe Lage (7 Submissions)
Category: Math/Dates
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(2 Votes)
Provides a good mathematical rounding of numbers instead of VB's "banking" round function.
' Revision C by Donald - 20060201 - (Bugfix)
' Revision D by Jeroen De Maeijer - 20100529 - (Bugfix)
' Revision E by Filipe Lage - 20100530 (speed improvements)
VBcoders
As you probably know, VB6 round function doesn't provide a good mathematical rounding of numbers, nor does it support negative rounding decimals
Example: Round(2.5) results in 2 instead of the right value: 3
Another example is that round doesn't support negative rounding decimals: Example: a Round of '1100' with decimalcases '-2' should result in 1000 and in VB internal round function, it fails with an error.
VBSpeed site (http://www.xbeat.net/vbspeed/) provides many examples and benchmarks of solutions to this problem, so I've decided to submit 2 source codes providing the SHORTEST good round function and the FASTEST good round function.
In this source code I'll provide the FASTEST (for 5 years and counting) to return the right numeric methematical rounding of a number, including support for negative rounding.
You can check benchmarks at http://www.xbeat.net/vbspeed/c_Round.htm (VBSpeed Round source codes).
New revision D, with bugfix and even faster.
So, here it is:
Public Function GoodRound(ByVal v As Double, Optional ByVal lngDecimals As Long = 0) As Double
' By Filipe Lage
' [email protected]
' msn: [email protected]
' Revision C by Donald - 20060201 - (Bugfix)
' Revision D by Jeroen De Maeijer - 20100529 - (Bugfix)
' Revision E by Filipe Lage - 20100530 (speed improvements)
Dim xint As Double, yint As Double, xrest As Double
Static PreviousValue As Double
Static PreviousDecimals As Long
Static PreviousOutput As Double
Static M As Double
If PreviousValue = v And PreviousDecimals = lngDecimals Then GoodRound = PreviousOutput: Exit Function
' Hey... it's the same number and decimals as before...
' So, the actual result is the same. No need to recalc it
If v = 0 Then Exit Function
' no matter what rounding is made, 0 is always rounded to 0
If PreviousDecimals = lngDecimals Then
' 20100530 Improvement by fclage - Moved M initialization here for speedup
If M = 0 Then M = 1 ' Initialization - M is never 0 (it is always 10 ^ n)
Else
' A different number of decimal places, means a new Multiplier
PreviousDecimals = lngDecimals
M = 10 ^ lngDecimals
End If
If M = 1 Then xint = v Else xint = v * CDec(M)
' Let's consider the multiplication of the number by the multiplier
' Bug fixed: If you just multiplied the value by M, those nasty reals came up
' So, we use CDEC(m) to avoid that
GoodRound = Fix(xint)
' The real integer of the number (unlike INT, FIX reports the actual number)
' 20060201: fix by Donald
If Abs(Fix(10 * (xint - GoodRound))) > 4 Then
If xint < 0 Then '20100529 fix by Zoenie:
' previous code would round -0,0714285714 with 1 decimal in the end result to 0.1 !!!
' 20100530 Speed improvement by Filipe - comparing vars with < instead of >=
GoodRound = GoodRound - 1
Else
GoodRound = GoodRound + 1
End If
End If
' First decimal is 5 or bigger ? If so, we'll add +1 or -1 to the result (later to be divided by M)
If M = 1 Then Else GoodRound = GoodRound / M
' Divides by the multiplier. But we only need to divide if M isn't 1
PreviousOutput = GoodRound
PreviousValue = v
' Let's save this last result in memory... may be handy ;)
End Function
