' Математическое округление Number до NumDigitsAfterDecimal (от 0 до 12) знаков
Function RoundM(ByVal Number, Optional ByVal NumDigitsAfterDecimal As Long)
  Static aDiff(0 To 12) As Double, d As Double, d2 As Double, res, i As Long
  Const EPS As Double = 0.00000000000001 ' 1e-14
  If aDiff(0) = 0 Then
    aDiff(0) = 0.5
    For i = 1 To UBound(aDiff)
     aDiff(i) = 0.5 * 10 ^ (-i)
    Next i
  End If
  
  If Number < 0 Then
    RoundM = -RoundM(-Number)
    Exit Function
  End If
 
  res = VBA.Round(Number, NumDigitsAfterDecimal)
  
  If NumDigitsAfterDecimal <= 12 Then
    d = aDiff(NumDigitsAfterDecimal)
    d2 = Number - res - d
    If d2 >= -EPS And d2 <= EPS Then
      res = res + d + d
    End If
  End If
  
  RoundM = res
End Function

Option Explicit
 
#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
         "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
    "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
 
Function MicroTimer() As Double
' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0
' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
    getTickCount cyTicks1
' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
 
Sub Test()
  Dim t As Double, nMax As Long, i As Long, d As Double
  nMax = 1000000
  
  ' Сначала без замера времени проверяем совпадение результатов участников
  For i = 1 To nMax
    d = WorksheetFunction.Round(1 + i / nMax, 2)
    If Abs(d - RoundM(1 + i / nMax, 2)) >= 0.00000000000001 Then Stop
    If Abs(d - CDbl(Format(1 + i / nMax, "0.00"))) >= 0.00000000000001 Then Stop
  Next i
    
  t = MicroTimer
  With WorksheetFunction
    For i = 1 To nMax
      d = .Round(1 + i / nMax, 2)
    Next i
  End With
   
  Debug.Print "WorksheetFunction.Round", FormatNumber(MicroTimer - t, 3)
   
  t = MicroTimer
  For i = 1 To nMax
     d = Round(1 + i / nMax + 0.00000001, 2)
  Next i
  Debug.Print "VBA.Round" & Space(10), FormatNumber(MicroTimer - t, 3)
   
  t = MicroTimer
  For i = 1 To nMax
     d = RoundM(1 + i / nMax, 2)
  Next i
  Debug.Print "RoundM" & Space(10), FormatNumber(MicroTimer - t, 3)
   
  t = MicroTimer
  For i = 1 To nMax
     d = CDbl(Format(1 + i / nMax, "0.00"))
  Next i
  Debug.Print "VBA.Format" & Space(10), FormatNumber(MicroTimer - t, 3)
   
End Sub