Lenteur d'une macro

Question

Lorsque j'exécute une macro qui modifie pas mal la feuille de départ, le temps d'exécution est assez long. Mais si je sors l'onglet de mon fichier (qui a plusieurs onglets, d'autres macros, des formules...), la macro s'exécute très rapidement ! Pourtant, la macro ne concerne que cette feuille, il n'y a aucun lien avec d'autres feuilles ou formules. Le seul lien serait que le bouton se trouve sur une autre feuille. J'ai essayé d'accélérer la macro avec deux-trois codes que j'ai trouvé (actualisation de l'écran, calculs automatiques...) mais rien n'y fait ! Quelqu'un aurait-il une piste ? Merci beaucoup ...

MFerrand · Answer

Mets la macro (avec balises Code STP !)...

MFerrand · Answer

Ca tient du gag ! Tu commences par supprimer 2 fois l'en-tête.... Qu'est-ce que tu ne supprimes pas ? Bon ! On supprime l'en-tête, on déplace le titre (lequel ?), on resupprime, on redéplace, on rere... C'est un fouillis inextricable ! Il faut un modèle de la feuille : situation de départ et mettre ce qui doit rester à l'arrivée, qu'on puisse définir une manière simple de passer de l'une à l'autre...

MFerrand · Answer

C'est déjà plus clair ! On va essayer une méthode inverse ! Je vois ça après manger ! Je passe en cuisine !...

MFerrand · Answer

Première ébauche ! Il faudrait ajouter pas mal de contrôles de validité mais je n'ai pas jugé utile pour l'instant, avant de savoir si la structure des feuilles que tu traites ainsi est stable ou subit des variations possibles...

Je ne peux garantir que ça va fonctionner dans tous les cas : vu la composition de la feuille, la mise au point a déjà présenté quelques difficultés sur quelques points délicats, et de légères variations de structure pourraient entraîner des résultats surprenants.

Il faudra donc cerner les variations possibles pour intégrer leur prise en compte dans la procédure (ou leur contournement)...

La méthode, si elle s'avère utilisable dans les cas où elle doit l'être, en ne faisant que prélever les données recherchées sur la feuille, sans y intervenir autrement, se révèlera nettement plus rapide...

Le code (je te mettrai des commentaires de repérage ultérieurement si tu le souhaites) :

Sub Test()
    Dim TR(), kRub, kTot, kTit, kJ, xClu, k%, i%, j%, h%, n%
    xClu = Split("code* nom* marq* devi*")
    With Worksheets("Feuille1").UsedRange
        Do While k <= .Columns.Count
            k = k + 1
            For i = 1 To .Rows.Count
                If .Cells(i, k) <> "" Then
                    If IsNumeric(.Cells(i, k)) Then
                        If kJ = "" Then kJ = i & ";" & k: h = h + 1
                        Exit For
                    ElseIf LCase(.Cells(i, k)) = "total" Then
                        If kTot = "" Then kTot = i & ";" & k: h = h + 1
                        Exit For
                    Else
                        For j = 0 To UBound(xClu)
                            If LCase(.Cells(i, k)) Like xClu(j) Then Exit For
                        Next j
                        If j > UBound(xClu) Then
                            If IsNumeric(Right(.Cells(i, k), 4)) Then
                                If kTit = "" Then kTit = i & ";" & k: h = h + 1
                            Else
                                If kRub = "" Then kRub = i & ";" & k: h = h + 1
                                Exit For
                            End If
                        End If
                    End If
                End If
            Next i
            If h = 4 Then Exit Do
        Loop
        If h < 4 Then
            MsgBox "Toutes les informations n'ont pu être recueillies.", vbCritical, _
             "Echec de la procédure !": Exit Sub
        End If
        xClu = Split(kRub, ";"): j = CInt(xClu(0)): k = CInt(xClu(1)): kRub = ""
        For i = j To .Rows.Count
            If .Cells(i, k) <> "" Then kRub = kRub & ";" & .Cells(i, k): n = i
        Next i
        xClu = Split(kTot, ";"): j = CInt(xClu(0)): k = CInt(xClu(1)): kTot = ""
        For i = j To .Rows.Count
            If LCase(.Cells(i, k)) = "total" Then kTot = kTot & ";" & i
        Next i
        kTot = kTot & ";" & n: n = 0
        xClu = Split(kTit, ";"): kTit = .Cells(CInt(xClu(0)), CInt(xClu(1))): xClu = Split(kTit)
        kTit = CDate(xClu(UBound(xClu))): kTit = DateSerial(Year(kTit), Month(kTit), 1) - 1
        xClu = Split(kJ, ";"): j = CInt(xClu(0)): k = CInt(xClu(1)): h = 0
        For i = k To .Columns.Count
            If .Cells(j, i) <> "" And IsNumeric(.Cells(j, i)) Then h = h + 1
        Next i
        kRub = Split(kRub, ";"): ReDim TR(UBound(kRub), h): kTot = Split(kTot, ";")
        For i = 1 To UBound(kRub)
            TR(i, 0) = kRub(i)
        Next i
        For i = k To .Columns.Count
            If .Cells(j, i) <> "" And IsNumeric(.Cells(j, i)) Then
                n = n + 1: TR(0, n) = kTit + CInt(.Cells(j, i))
                For h = 1 To UBound(kRub)
                    TR(h, n) = .Cells(CInt(kTot(h)), i)
                Next h
            End If
        Next i
    End With
    j = UBound(TR, 1)
    For i = 1 To UBound(TR, 2)
        h = InStr(1, TR(j, i), Chr(10))
        If h > 0 Then TR(j, i) = Left(TR(j, i), h - 1)
    Next i
    Application.ScreenUpdating = False
    With Worksheets.Add(after:=Worksheets("Feuille1"))
        With .Range("A1").Resize(UBound(TR, 1) + 1, UBound(TR, 2) + 1)
            .Value = TR
            .Columns(1).ColumnWidth = 16
            With .Offset(1).Resize(UBound(TR, 1) - 1).Borders
                .LineStyle = xlContinuous: Weight = xlThin
            End With
            With .Rows(UBound(TR, 1) + 1)
                .HorizontalAlignment = xlCenter: .Font.Bold = True
            End With
            .Offset(, 1).Resize(UBound(TR, 1), UBound(TR, 2)).HorizontalAlignment = xlCenter
        End With
    End With
End Sub

Pour la tester, la lancer à partir de la boîte de dialogue macro. Je n'ai pas mis de bouton, ne sachant comment elle sera intégrée dans le contexte de travail.

En cas d'essais sur d'autres feuilles du même type, me prévenir des problèmes éventuels, et surtout des anomalies dont il faudra cerner la source en comparant avec la structure de la feuille à partir de laquelle la proc. a été établie.

Cordialement.

14julienbr-depart.zip (21.80 Ko)