Temps d'exécution trop long

Question

Bonjour,

j'ai développé un module me permettant de gérer des alertes. Il semble bien fonctionner, le problème est qu'à l'exécution, le programme boucle. Il faut que j'interrompe l'exécution avec Echap pour que le traitement se termine. Mais même après l'interruption, le traitement a été fait.


La procédure est appelé à chaque fois que je fais un changement dans une cellule d'une colonne (que j'ai definie) de ma feuille Excel.

Voila mon code :

Sub Gestion_Retard()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim t As Integer
Dim nomTBdependant As String
Dim nomTBprealable As String
Dim oSheetTB As Worksheet
Set oSheetTB = Sheets("TB")


'Blocage de l'écran
Application.ScreenUpdating = False
TBPrincipal = Evaluate("TBPrincipal")
Application.Goto Reference:="Curseur"
'Récupère le numéro de la dernière ligne de la zone
dernièreLigne1 = Cells(65536, 1).End(xlUp).Row


'Instruction de blocage du recalcul automatique
Application.Calculation = xlCalculationManual


For x = 6 To 31 'dernièreLigne1
    Select Case Cells(x, 8).Value
        Case "PAS PRÊT - ALERTE 2"
            Cells(x, 4).Value = "RETARD !"
            nomTBprealable = Range("C" & x).Value
            For y = 2 To 27
                z = 0
                Do While oSheetTB.Cells(y, z + 3).Value <> ""
Line1:
                    If oSheetTB.Cells(y, z + 3).Value = nomTBprealable Then
                        nomTBdependant = oSheetTB.Cells(y, 2).Value
                        For t = 6 To 31
                            If Cells(t, 3).Value = nomTBdependant Then
                                Cells(t, 4).Value = "RETARD ! cause : TB " & Range("C" & x).Value
                                Cells(t, 8).Value = "EN ATTENTE DES SOURCES"
                            End If
                        Next t
                        Exit Do
                    ElseIf oSheetTB.Cells(y, z + 3).Value = "" Then
                        Exit Do
                    Else
                        z = z + 1
                        GoTo Line1
                    End If
                    z = z + 1
                Loop
            Next y
            
        Case "LIVRE"
            Cells(x, 4).Value = "OK"
        Case "PRÊT"
            Cells(x, 4).Value = ""
        Case Else
            If Cells(x, 4).Value = "RETARD !" Then
                Cells(x, 4).Value = ""
            ElseIf Cells(x, 4).Value = "OK" Then
                Cells(x, 4).Value = ""
            End If
    End Select
Next x


'Déblocage de l'écran
Application.ScreenUpdating = True


'Instruction de déblocage du recalcul automatique
Application.Calculation = xlCalculationAutomatic


End Sub


Peut- être avez vous trouvé mon problème ou si vous avez des suggestions afin d'alléger mon code, je suis preneuse.

Merci d'avance.

jmfmarques · Answer

Bonjour,

Je ne connais pas VBA...
Mais, par pur instinct, je me dirais que le recalcul automatic va transformer l'affichage (qui, lui, prend du temps).
Je commencerais donc par 
1) rerendre le calcul automatique
puis
2) restituer l'affichage

mimi_939 · Answer

Il semblerait que ça ne soit pas vraiment le recalcul automatic qui fasse durer le traitement.
Mon code est peut-être trop lourd mais je ne vois pas comment alléger le code sans modifier le traitement que je veux faire!

Si vous avez une idée, quelque chose qui pourrait m'aider à avancer, n'hésitez pas.

Merci.

jmfmarques · Answer

Ce n'est pas le recalcul en soi... mais le fait que, l'affichage étant réhabilité, l'affichage sera sans cesse modifié par ce recalcul...
Je répète donc : ne réhabiliter l'affichage qu'après recaclcul me parait souhaitable ...
Enfin... c'est ce que je pense... (en dehors d'autres considérations éventuelles d'optimisation de ton code.... puisque je ne connais pas VBA)

mimi_939 · Answer

J'ai essayé mais le temps d'exécution est toujours aussi long ...

mortalino · Answer

humm je dirai que 3 ou 4 boucles imbriquées beh faut le temps qu'elles se fassent. Si ça prend un peu de temps (2 ou 3 minutes), ça ne me choque pas.
Par contre, tu as deux fois une bouxle de 6 à 31, tu peux peut-être l'éviter, enfin à voir. (ainsi que ton GoTo)

PS : attention pour ton histoire d'interruption de programme avec ton Echap, cela risque de ne pas remettre le ScreenUpdating à true et le calcul auto (car la procédure ayant été interrompue, ton dev n'a pas lu ces instructions)

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

mimi_939 · Answer

En supprimant une ligne de code ( en rose ci dessous), tout s'exécute rapidement et correctement. Le problème est que j'ai besoin de cette ligne!
Comment est-ce possible ?

Sub Gestion_Retard()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim t As Integer
Dim nomTBdependant As String
Dim nomTBprealable As String
Dim oSheetTB As Worksheet
Set oSheetTB = Sheets("TB")


'Blocage de l'écran
Application.ScreenUpdating = False
TBPrincipal = Evaluate("TBPrincipal")
Application.Goto Reference:="Curseur"
'Récupère le numéro de la dernière ligne de la zone
dernièreLigne1 = Cells(65536, 1).End(xlUp).Row


'Instruction de blocage du recalcul automatique
Application.Calculation = xlCalculationManual


For x = 6 To 31 'dernièreLigne1
    Select Case Cells(x, 8).Value
        Case "PAS PRÊT - ALERTE 2"
            Cells(x, 4).Value = "RETARD !"
            nomTBprealable = Range("C" & x).Value
            For y = 2 To 27
                z = 0
                Do While oSheetTB.Cells(y, z + 3).Value <> ""
Line1:
                    If oSheetTB.Cells(y, z + 3).Value = nomTBprealable Then
                        nomTBdependant = oSheetTB.Cells(y, 2).Value
                        For t = 6 To 31
                            If Cells(t, 3).Value = nomTBdependant Then
                                Cells(t, 4).Value = "RETARD ! cause : TB " & Range("C" & x).Value
                                Cells(t, 8).Value = "EN ATTENTE DES SOURCES"
                            End If
                        Next t
                        Exit Do
                    ElseIf oSheetTB.Cells(y, z + 3).Value = "" Then
                        Exit Do
                    Else
                        z = z + 1
                        GoTo Line1
                    End If
                    z = z + 1
                Loop
            Next y
            
        Case "LIVRE"
            Cells(x, 4).Value = "OK"
        Case "PRÊT"
            Cells(x, 4).Value = ""
        Case Else
            If Cells(x, 4).Value = "RETARD !" Then
                Cells(x, 4).Value = ""
            ElseIf Cells(x, 4).Value = "OK" Then
                Cells(x, 4).Value = ""
            End If
    End Select
Next x

Comment faire pour conserver cette ligne tout en ayant un temps d'exécution correct.

mortalino · Answer

Bah je ne t'apporterai rien en te disant ça (et j'en suis désolé) mais c'est illogique que le temps d'exécution diffère avec ou sans cette ligne d'instruction !
Ce  n'est que le placement d'une valeur dans une cellule, donc très rapide à faire

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

mimi_939 · Answer

Je suis complètement d'accord et c'est pour ça que je ne comprends plus rien!
Je ne sais plus quoi faire pour résoudre ce problème.

mortalino · Answer

Quelques fois, (surtout pour une petite procédure comme celle-ci) il vaut mieux repartir de 0, à savoir tu te fais un schéma de ce que ça doit faire, vois si y'a pas moyen de décomposer ton travail en 3 fonctions (vu qu'il y a 3 boucles) avec paramètres, et suivant valeurs... faire ce qui doit être fait

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

cs_MPi · Answer

D'après moi, le "Line1:" et le Goto Line1 ne sont pas nécessaires. La boucle Do s'en chargera elle-même.

De plus, les 2 boucles imbriquées 6 à 31 me semblent superflues à première vue... il me semblait qu'on avait déjà réglé ce problème, non ?

MPi

Temps d'exécution trop long

10 réponses

Votre réponse

Discussions similaires