• Home
 · 
• Math/Dates
 · 
• FASTEST GoodRound function (Revision D) 2010-06-10 Update

FASTEST GoodRound function (Revision D) 2010-06-10 Update

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)

Rate FASTEST GoodRound function (Revision D) 2010-06-10 Update

• 1
• 2
• 3
• 4
• 5

(3(3 Vote))

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