excel-vba
Optimisation Excel-VBA

Introduction

Remarques

Désactivation de la mise à jour de la feuille de calcul

La désactivation du calcul de la feuille de calcul peut réduire considérablement le temps d'exécution de la macro. De plus, la désactivation des événements, la mise à jour de l'écran et les sauts de page seraient bénéfiques. La suite Sub peut être utilisée dans n'importe quelle macro à cette fin.

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

Pour l'optimisation, suivez le pseudo-code ci-dessous:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Vérification de l'heure d'exécution

Des procédures différentes peuvent donner le même résultat, mais elles utiliseraient un temps de traitement différent. Pour vérifier lequel est le plus rapide, un code comme celui-ci peut être utilisé:

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

Utiliser des blocs avec

L'utilisation de blocs peut accélérer le processus d'exécution d'une macro. Au lieu d'écrire une plage, un nom de graphique, une feuille de calcul, etc., vous pouvez utiliser des blocs comme ci-dessous;

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

Ce qui est plus rapide que cela:

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

Remarques:

• Une fois qu'un bloc With est entré, l'objet ne peut plus être modifié. Par conséquent, vous ne pouvez pas utiliser une seule instruction With pour affecter plusieurs objets différents.

• Ne sautez pas dans ou hors des blocs With . Si des instructions dans un bloc With sont exécutées, mais que l'instruction With ou End With n'est pas exécutée, une variable temporaire contenant une référence à l'objet reste en mémoire jusqu'à ce que vous quittiez la procédure

• Ne pas boucler l'intérieur avec des instructions, surtout si l'objet mis en cache est utilisé comme itérateur

• Vous pouvez imbriquer des instructions en en plaçant une avec un bloc dans une autre. Cependant, comme les membres des blocs With externes sont masqués dans l'intérieur avec des blocs, vous devez fournir une référence d'objet pleinement qualifiée dans un bloc With interne à tout membre d'un objet dans un bloc With externe.

Exemple d'imbrication:

Cet exemple utilise l'instruction With pour exécuter une série d'instructions sur un seul objet.
L'objet et ses propriétés sont des noms génériques utilisés à des fins d'illustration uniquement.

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

Plus d'infos sur MSDN

Suppression de lignes - Performance

• La suppression des lignes est lente, en particulier lors de la lecture en boucle de cellules et de la suppression de lignes, une par une

• Une approche différente consiste à utiliser un filtre automatique pour masquer les lignes à supprimer.

• Copiez la plage visible et collez-la dans une nouvelle feuille de travail

• Retirez entièrement la feuille initiale

• Avec cette méthode, plus il y a de lignes à supprimer, plus vite ce sera

Exemple:

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

Désactivation de toutes les fonctionnalités d'Excel Avant d'exécuter de grandes macros

Les procédures ci-dessous désactivent temporairement toutes les fonctionnalités Excel au niveau WorkBook et WorkSheet.

• FastWB () est une bascule qui accepte les indicateurs On ou Off

• FastWS () accepte un objet facultatif WorkSheet, ou aucun

• Si le paramètre ws est manquant, toutes les fonctionnalités seront activées et désactivées pour toutes les feuilles de calcul de la collection.

  • Un type personnalisé peut être utilisé pour capturer tous les paramètres avant de les désactiver
  • À la fin du processus, les paramètres initiaux peuvent être restaurés

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

Restaurer tous les paramètres Excel par défaut

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

Optimisation de la recherche d'erreur par débogage étendu

Utiliser des numéros de ligne ... et les documenter en cas d'erreur ("L'importance de voir Erl")

Détecter quelle ligne soulève une erreur est une partie substantielle de tout débogage et réduit la recherche de la cause. Pour documenter les lignes d'erreur identifiées avec une brève description, le suivi des erreurs est réussi, au mieux, avec les noms des modules et des procédures. L'exemple ci-dessous enregistre ces données dans un fichier journal.

Contexte

L'objet d'erreur renvoie le numéro d'erreur (Err.Number) et la description de l'erreur (Err.Description), mais ne répond pas explicitement à la question de l'emplacement de l'erreur. La fonction Erl, cependant, le fait, mais à la condition que vous ajoutez les numéros de ligne *) au code (BTW une de plusieurs autres concessions aux anciens temps de base).

S'il n'y a aucune ligne d'erreur, alors la fonction Erl renvoie 0, si la numérotation est incomplète, vous obtenez le dernier numéro de ligne de la procédure.

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

' Code supplémentaire pour afficher le fichier journal

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