Optimisation macro avec boucles

[Mathar]

Salut le forum,

Je vous appelle à l'aide pour un problème qui me fait tourner en rond depuis une semaine pour diminuer le temps d’exécution d'une macro interminable...

Je vous explique la structure du fichier et l'action de la macro:

• 3 onglets: Sorties; Calcul; Résultat
• La macro prend des numéro de référence dans l'onglet sortie (par intervalle)
• Ils sont ajoutés dans la table Calcul comprenant un tableau avec des formules déjà préparées
• les formules permettent de détecter les erreurs à chaque ligne
• La macro parcour les 3 colonnes d'erreurs et les corrige (ajout ligne +modif valeurs)
• Les données finales sont copiées et leur valeur copiée dans le tableau résultat
• puis nouvel intervalle et ainsi de suite

J'ai pensé à cette astuce des intervalles pour éviter de traiter un tableau de 16000 lignes mais bizarrement le temps de traitement est toujours exponentiel, alors qu'en appliquant cette astuce manuellement il est linéaire... Je passe par des "compteurs" dans des cellules, peut-être que le problème vient en partie de là.

Je pense que quelque chose doit clocher dans mon code, je vous montre le principal, les macro Erreur1/2/3 sont similaires. Je m'excuse par avance pour ma faible qualité de codage, je débute...

Code principal:

Sub CorrigErreurs()

Application.ScreenUpdating = False

Sheets("Sorties").Activate

Dim NbLigne As Long
With ActiveSheet
NbLigne = Range("A65536").End(xlUp).Row
End With

Dim First As Long
Dim Last As Long
Dim Ref As Long
Dim Sum As Long
Dim Interv As Long

Sum = 0
Interv = 100 'valeur de l'intervalle

Range("M1").Value = 2
Range("N1").FormulaR1C1 = "=RC[-1]+" & Interv & ""
Range("N2").FormulaArray = "=MAX(IF(C[-10]<>"""",ROW(C[-10])))"
Ref = Range("N1").Value
Range("O1").FormulaArray = _
        "=IF(RC[-1]+COUNTIF(R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11],""""&R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11])-1>R[1]C[-1],R[1]C[-1],RC[-1]+COUNTIF(R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11],""""&R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11])-1)"


Do Until Sum = NbLigne

    First = Range("M1").Value
    Last = Range("O1").Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Sheets("Calcul").Range("J2:J" & Last - First + 2).Value = Sheets("Sorties").Range("A" & First & ":A" & Last).Value
    Sheets("Calcul").Activate
'Correction des erreurs
    Erreur1
    Do Until Range("AE1").Value = 0
        Erreur3
    Loop
    Do Until Range("AD1").Value = 0
            Erreur2
        Loop
'Copie Valeurs
    Sheets("Résultats").Activate
    Dim NbLigneR As Long
    With ActiveSheet
    NbLigneR = Range("A65536").End(xlUp).Row
    End With
    Sheets("Calcul").Activate
    Dim NbLigneC As Long
    With ActiveSheet
    NbLigneC = Range("A65536").End(xlUp).Row
    End With

    Range("A2:Z" & NbLigneC).Copy
    Sheets("Résultats").Range("A" & NbLigneR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
'Netoyage
    Range(Rows("5:5"), Selection.End(xlDown)).Delete Shift:=xlUp
    Range("B3:H3").AutoFill Destination:=Range("B3:H4")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Sorties").Activate
    Sum = Last
    Range("M1").Value = Range("O1").Value + 1

    Ref = Range("N1").Value

    Range("O1").FormulaArray = _
        "=IF(RC[-1]+COUNTIF(R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11],""""&R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11])-1>R[1]C[-1],R[1]C[-1],RC[-1]+COUNTIF(R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11],""""&R[" & Ref - 1 & "]C[-11]:R[" & NbLigne - 1 & "]C[-11])-1)"
Loop


Application.ScreenUpdating = True


End Sub

Erreur type:

Sub Erreur2()

Application.Calculation = xlCalculationManual

Dim NbLigne As Long
With ActiveSheet
NbLigne = Range("A65536").End(xlUp).Row
End With

Dim Z As Long
Dim X As Long
Dim Y As Long

Dim E1 As Long
    For E1 = 2 To NbLigne * 1.1
        If Range("W" & E1) > 0 Then
           
Z = Range("S" & E1).Value
X = Range("Q" & E1).Value
Y = Range("W" & E1).Value

Rows(E1 + 1 & ":" & E1 + 1).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Changement Valeurs
            Range("J" & E1 + 1).Value = Range("J" & E1).Value
            Range("Q" & E1).Value = X - Y
            Range("R" & E1).Value = X - Y
            Range("S" & E1).Value = Z - Y
            Range("Q" & E1 + 1).Value = Y
            Range("R" & E1 + 1).Value = Y
'Actualiser formules
            If Range("A" & E1 + 2).Value = "" Then
                Range("U" & (E1 - 1) & ":X" & (E1 - 1)).AutoFill Destination:=Range("U" & E1 - 1 & ":X" & E1 + 1), Type:=xlFillDefault
                Range("B" & E1 - 1).AutoFill Destination:=Range("B" & E1 - 1 & ":B" & E1 + 1), Type:=xlFillDefault
            Else
            Range("U" & (E1 - 1) & ":X" & (E1 - 1)).AutoFill Destination:=Range("U" & E1 - 1 & ":X" & E1 + 2), Type:=xlFillDefault
            Range("B" & E1 - 1).AutoFill Destination:=Range("B" & E1 - 1 & ":B" & E1 + 1), Type:=xlFillDefault
            End If
'Recalculer zone de travail
            Range(E1 - 1 & ":" & E1 + 2).Calculate
            E1 = E1 - 1
        End If
    Next E1
  
Application.Calculation = xlCalculationAutomatic
End Sub

Voilà c'est assez lourd à lire mais pas bien compliqué je pense, ou alors j'ai fait n'importe quoi

Merci d'avance pour vos remarques

 

[titiborregan5]

Re : Optimisation macro avec boucles

Bonjour Mathar, le forum,

commence ton code par application.screenupdating=false et termine le par true.

ça va déjà accélérer un peu je pense.

De plus les activate bouffent de la mémoire il me semble (un peu comme les select). Evite les au max en passant par sheets("xxx"). ... ou with sheets("xxx")

En espérant que ça t'aide un peu!

A+
Tibo