excel-vba
Optimización Excel-VBA

Introducción

Observaciones

Desactivando la actualización de la hoja de trabajo

Deshabilitar el cálculo de la hoja de trabajo puede disminuir significativamente el tiempo de ejecución de la macro. Además, deshabilitar eventos, actualizar la pantalla y saltos de página sería beneficioso. El siguiente Sub puede ser usado en cualquier macro para este propósito.

Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not(isOn)
    Application.ScreenUpdating = Not(isOn)
    ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

Para la optimización siga el siguiente pseudo-código:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Comprobación del tiempo de ejecución.

Diferentes procedimientos pueden dar el mismo resultado, pero usarían un tiempo de procesamiento diferente. Para ver cuál es más rápido, se puede usar un código como este:

time1 = Timer

For Each iCell In MyRange
   iCell = "text"
Next iCell

time2 = Timer

For i = 1 To 30
   MyRange.Cells(i) = "text"
Next i

time3 = Timer

debug.print "Proc1 time: " & cStr(time2-time1)
debug.print "Proc2 time: " & cStr(time3-time2)

MicroTimer :

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

Function MicroTimer() As Double
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency        'Get frequency
    getTickCount cyTicks1                                   'Get ticks
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency 'Returns Seconds
End Function

Utilizando con bloques

Usar con bloques puede acelerar el proceso de ejecutar una macro. En lugar de escribir un rango, un nombre de gráfico, una hoja de trabajo, etc., puede usar with-blocks como abajo;

With ActiveChart
    .Parent.Width = 400
    .Parent.Height = 145
    .Parent.Top = 77.5 + 165 * step - replacer * 15
    .Parent.Left = 5
End With 

Que es más rápido que esto:

ActiveChart.Parent.Width = 400
ActiveChart.Parent.Height = 145
ActiveChart.Parent.Top = 77.5 + 165 * step - replacer * 15
ActiveChart.Parent.Left = 5

Notas:

• Una vez que se ingresa un bloque With, el objeto no se puede cambiar. Como resultado, no puede usar una sola instrucción With para afectar una cantidad de objetos diferentes

• No saltes dentro o fuera de los bloques . Si se ejecutan las instrucciones en un bloque With, pero no se ejecuta la instrucción With o End With, una variable temporal que contiene una referencia al objeto permanece en la memoria hasta que salga del procedimiento.

• No bucle dentro de las declaraciones, especialmente si el objeto almacenado en caché se usa como un iterador

• Puede anidar con sentencias colocando una con bloque dentro de otra. Sin embargo, debido a que los miembros de los bloques Con externos están enmascarados dentro de los bloques Con internos, debe proporcionar una referencia de objeto completamente calificada en un bloque Con interno a cualquier miembro de un objeto en un bloque Con externo.

Ejemplo de anidación:

Este ejemplo utiliza la instrucción With para ejecutar una serie de instrucciones en un solo objeto.
El objeto y sus propiedades son nombres genéricos utilizados solo para fines de ilustración.

With MyObject 
    .Height = 100               'Same as MyObject.Height = 100. 
    .Caption = "Hello World"    'Same as MyObject.Caption = "Hello World". 
    With .Font 
        .Color = Red            'Same as MyObject.Font.Color = Red. 
        .Bold = True            'Same as MyObject.Font.Bold = True. 
        MyObject.Height = 200   'Inner-most With refers to MyObject.Font (must be qualified
    End With
End With

Más información en MSDN

Eliminación de filas - Rendimiento

• La eliminación de filas es lenta, especialmente cuando se recorren las celdas y se eliminan filas, una por una

• Un enfoque diferente es usar un Autofiltro para ocultar las filas que se eliminarán

• Copie el rango visible y péguelo en una nueva hoja de trabajo

• Retire la hoja inicial por completo.

• Con este método, cuantas más filas se eliminen, más rápido será

Ejemplo:

Option Explicit

'Deleted rows: 775,153, Total Rows: 1,000,009, Duration: 1.87 sec

Public Sub DeleteRows()
    Dim oldWs As Worksheet, newWs As Worksheet, wsName As String, ur As Range

    Set oldWs = ThisWorkbook.ActiveSheet
    wsName = oldWs.Name
    Set ur = oldWs.Range("F2", oldWs.Cells(oldWs.Rows.Count, "F").End(xlUp))

    Application.ScreenUpdating = False
    Set newWs = Sheets.Add(After:=oldWs)    'Create a new WorkSheet

    With ur    'Copy visible range after Autofilter (modify Criteria1 and 2 accordingly)
        .AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd, Criteria2:="<>"
        oldWs.UsedRange.Copy
    End With
    'Paste all visible data into the new WorkSheet (values and formats)
    With newWs.Range(oldWs.UsedRange.Cells(1).Address)
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteAll
        newWs.Cells(1, 1).Select: newWs.Cells(1, 1).Copy
    End With

    With Application
        .CutCopyMode = False
        .DisplayAlerts = False
            oldWs.Delete
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    newWs.Name = wsName
End Sub

Deshabilitar toda la funcionalidad de Excel antes de ejecutar macros grandes

Los siguientes procedimientos deshabilitarán temporalmente todas las funciones de Excel en WorkBook y WorkSheet level.

• FastWB () es un conmutador que acepta indicadores de activación o desactivación

• FastWS () acepta un objeto WorkSheet opcional, o ninguno

• Si falta el parámetro ws, se activarán y desactivarán todas las funciones para todas las hojas de trabajo de la colección.

  • Se puede usar un tipo personalizado para capturar todas las configuraciones antes de apagarlas
  • Al final del proceso, las configuraciones iniciales pueden ser restauradas

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        If .DisplayAlerts <> Not opt Then .DisplayAlerts = Not opt
        If .DisplayStatusBar <> Not opt Then .DisplayStatusBar = Not opt
        If .EnableAnimations <> Not opt Then .EnableAnimations = Not opt
        If .EnableEvents <> Not opt Then .EnableEvents = Not opt
        If .ScreenUpdating <> Not opt Then .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet, Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ThisWorkbook.Sheets
            OptimiseWS ws, opt
        Next
    Else
        OptimiseWS ws, opt
    End If
End Sub
Private Sub OptimiseWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Restaura todas las configuraciones de Excel a las predeterminadas

Public Sub XlResetSettings()    'default Excel settings
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .DisplayStatusBar = True
        .EnableAnimations = False
        .EnableEvents = True
        .ScreenUpdating = True
        Dim sh As Worksheet
        For Each sh In Application.ThisWorkbook.Sheets
            With sh
                .DisplayPageBreaks = False
                .EnableCalculation = True
                .EnableFormatConditionsCalculation = True
                .EnablePivotTable = True
            End With
        Next
    End With
End Sub

Optimizando la búsqueda de errores por depuración extendida

Usando números de línea ... y documentándolos en caso de error ("La importancia de ver Erl")

Detectar qué línea genera un error es una parte sustancial de cualquier depuración y limita la búsqueda de la causa. Para documentar las líneas de error identificadas con una breve descripción, se completa un seguimiento exitoso de los errores, en el mejor de los casos junto con los nombres del módulo y el procedimiento. El siguiente ejemplo guarda estos datos en un archivo de registro.

Fondo

El objeto de error devuelve el número de error (Err.Number) y la descripción del error (Err.Description), pero no responde explícitamente a la pregunta dónde ubicar el error. Sin embargo, la función Erl sí lo hace, pero a condición de que agregue * números de línea ) al código (por cierto, una de varias otras concesiones a los tiempos básicos anteriores).

Si no hay ninguna línea de error, entonces la función Erl devuelve 0, si la numeración está incompleta, obtendrá el último número de línea anterior del procedimiento.

Option Explicit


Public Sub MyProc1()
Dim i As Integer
Dim j As Integer
On Error GoTo LogErr
10     j = 1 / 0    ' raises an error
okay:
Debug.Print "i=" & i
Exit Sub

LogErr:
MsgBox LogErrors("MyModule", "MyProc1", Err), vbExclamation, "Error " & Err.Number
Stop
Resume Next
End Sub

Public Function LogErrors( _
           ByVal sModule As String, _
           ByVal sProc As String, _
           Err As ErrObject) As String
' Purpose: write error number, description and Erl to log file and return error text
  Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"
  Dim sLogTxt  As String
  Dim lFile    As Long

' Create error text
  sLogTxt = sModule & "|" & sProc & "|Erl " & Erl & "|Err " & Err.Number & "|" & Err.Description

  On Error Resume Next
  lFile = FreeFile

  Open sLogFile For Append As lFile
  Print #lFile, Format$(Now(), "yy.mm.dd hh:mm:ss "); sLogTxt
      Print #lFile,
  Close lFile
' Return error text
  LogErrors = sLogTxt
 End Function

' Código adicional para mostrar el archivo de registro

Sub ShowLogFile()
Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"

On Error GoTo LogErr
Shell "notepad.exe " & sLogFile, vbNormalFocus

okay:
On Error Resume Next
Exit Sub

LogErr:
MsgBox LogErrors("MyModule", "ShowLogFile", Err), vbExclamation, "Error No " & Err.Number
Resume okay
End Sub