VBA: Midiendo tiempos de ejecución

Muy frecuentemente, cuando trabajo con mis clientes, me preguntan qué fórmula es mejor y cúal es más rápida o ágil a la hora del cálculo... No hay una respuesta fácil, por que depende de la situación y contexto, a veces no es posible optar por la mejor... y nos conformamos 'con la menos mala'.
En todo caso hoy publicaré una macro proporcionada entre la documentación de Microsoft que nos permitirá medir los tiempos que emplea una fórmula o conjunto de ellas en ejecutarse completamente. Es una macro muy vieja, pero poco conocida... por ese motivo me permito hacerle un poco de publicidad ;-)

Es una manera muy cómoda de controlar tiempos y decidir, en su caso, si buscamos una alternativa a la función desarrollada....

Añadiremos en un módulo estándar del editor de VBA (o si lo prefieres en el libro de macros personal) el siguiente conjunto de procedimientos.

En primer lugar llamamos a las funciones API de Windows según la versión de nuestro editor de VBA:

'preparación para emplear unas librerias y funciones API u otras según la versión de VBA que tengamos
'las dos funciones que necesitamos son:
'getFrequency
'getTickCount

#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

A continuación, empleando estas funciones, definimos una función 'temporizador':

Function MicroTimer() As Double
' Mide los segundos empleados...
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0

' Obtenemos la frecuencia a partir de la función API 'getFrequency'
'función que hemos llamado en las primeras líneas
If cyFrequency = 0 Then getFrequency cyFrequency

' Obtenemos los ticks a partir de la función API 'getTickCount'
getTickCount cyTicks1

' y calculamos los segundos a través del cociente entre ticks y frecuencia
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Empleando esta UDF recién creada, que es capaz de contabilizar segundos... insertamos el procedimiento que se encargará de procesar de acuerdo a la elección del usuario, los tiempos de ejecución de un:
-rango/celda
-la hoja activa
-el libro activo de trabajo
-todos los libros abiertos

Insertamos pues, a continuación, el siguiente procedimiento:

Sub DoCalcTimer(jMethod As String)
Dim dTime As Double
Dim dOvhd As Double
Dim oRng As Range
Dim oCell As Range
Dim oArrRange As Range
Dim sCalcType As String
Dim lCalcSave As Long
Dim bIterSave As Boolean

'controlamos un posible fallo
On Error GoTo Errhandl

' Iniciamos el contador...
dTime = MicroTimer

' guardamos la lconfiguración actual
lCalcSave = Application.Calculation     'de la Opción de cálculo que tengamos
bIterSave = Application.Iteration       'y de la iteración configurada

'la disponemos en Opcion de cálculo manual
If Application.Calculation <> xlCalculationManual Then
    Application.Calculation = xlCalculationManual
End If

'y procesamos el conteo según la elección  del usuario:
' rango o celda
' hoja
' libro activo
' todos los libros activos

'lo gestionamos con un Select Case
Select Case jMethod
Case "celda_rango"  'para el rango/celda seleccionado

    ' Desactivamos la iteración 8si estuviera marcada).
    If Application.Iteration <> False Then
        Application.Iteration = False
    End If
    
    ' Disponemos un topo de celdas seleccionadoas,
    ' y limitamos al UsedRange.
    If Selection.Count > 1000 Then
        Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
    Else
        Set oRng = Selection
    End If

    ' Incluimos otras celdas fuera de la selección
    For Each oCell In oRng
        If oCell.HasArray Then
            If oArrRange Is Nothing Then
                Set oArrRange = oCell.CurrentArray
            End If
            If Intersect(oCell, oArrRange) Is Nothing Then
                Set oArrRange = oCell.CurrentArray
                Set oRng = Union(oRng, oArrRange)
            End If
        End If
    Next oCell
    'preparamos texto recapitulativo (la parte inicial).
    sCalcType = "Calculadas " & CStr(oRng.Count) & " Celda/s en el rango seleccionado en: "
    
Case "hoja"  'para la hoja activa
    sCalcType = "Hoja recalculada " & ActiveSheet.Name & " en: "
Case "libro"  'para el libro de trabajo activo
    sCalcType = "Libro abierto recalculado en: "
Case "todos_libros"  'para todos los libros abiertos
    sCalcType = "Recalculo completo de todos los libros abiertos en: "
End Select

' Reiniciamos el temporizador
dTime = MicroTimer

'y calculamos tiempos según la elección de celda/rango/hoja/libro/libros
'forzando un recálculo controlado de esa celda, rango, hoja, libro o todos los libros...
Select Case jMethod
Case "celda_rango"  'para el rango/celda seleccionado
    If Val(Application.Version) >= 12 Then
        oRng.CalculateRowMajorOrder
    Else
        oRng.Calculate
    End If
Case "hoja"  'para la hoja activa
    ActiveSheet.Calculate
Case "libro"  'para el libro de trabajo activo
    Application.Calculate
Case "todos_libros"  'para todos los libros abiertos
    Application.CalculateFull
End Select

' finalmente calculamos duración del proceso de cálculo.
dTime = MicroTimer - dTime
On Error GoTo 0

'redondeamos
dTime = Round(dTime, 5)
'y mostramos el mensanje final
MsgBox sCalcType & " " & CStr(dTime) & " segundos", vbOKOnly + vbInformation, "CalcTimer"


Finish:
    'restauramos opciones de cálculo e iteración iniciales
    If Application.Calculation <> lCalcSave Then
         Application.Calculation = lCalcSave
    End If
    If Application.Iteration <> bIterSave Then
         Application.Iteration = bIterSave
    End If
    Exit Sub
    
Errhandl:
    'la salida en caso de error
    On Error GoTo 0
    MsgBox "Unable to Calculate " & sCalcType, vbOKOnly + vbCritical, "CalcTimer"
    GoTo Finish
End Sub

Para terminar incluiremos cuatro 'miniprocedimientos' que nos permitirán ejecutar una de las cuatro opciones:

Sub RangeTimer()
    DoCalcTimer "celda_rango"         
End Sub
''''''''''''''''''''''''''
Sub SheetTimer()
    DoCalcTimer "hoja"                
End Sub
''''''''''''''''''''''''''
Sub RecalcTimer()
    DoCalcTimer "libro"   
End Sub
''''''''''''''''''''''''''
Sub FullcalcTimer()
    DoCalcTimer "todos_libros"        
End Sub

¿Cómo funciona todo esto?. Muy fácil... Selecciona una celda o rango de celdas con funciones o fórmulas, presiona Alt+F8 y ejecuta la macro 'RangeTimer'.

Aparecerá el mensaje configurado anteriormente indicando el tiempo empleado en completar el cálculo:

También puedes asignar las macros a botones, o a métodos abreviados ;-)

Muy recomendable ejecutar el proceso dos o tres veces para tener una realidad más precisa del tiempo necesario de recalculo...

De igual forma procederíamos para obtener el cálculo de hoja, libro o todos los libros abierto ;-)