Macro temps d'exécution long
Bonsoir à toutes (oui j'aime à penser qu'il y a quelque part une excelleuse dévouée et passionnée
Je me heurte à un temps d'exécution bien trop lent de ma macro.
Dans un classeur existent 2 feuilles ("encours" et "archives") avec respectivement un tableau structuré ("Tbl_encours" et "Tbl_archives"). Ces tables portent les datas de différentes lignes de commandes : la semaine en cours de traitement dans la première feuille, l'ensemble de l'historique des semaines archivées dans la seconde.
Le but de la macro est de reporter sur chaque ligne de commande en cours de traitement un commentaire (en colonne H) dressant un historique rapide de cette même ligne de commande au fil des semaines passées (on reporte notamment des notes de texte, des quantités, dates etc pouvant varier chaque semaine), depuis sa création.
Pour info, cette instruction fonctionne. J'ai utilisé un dictionnaire (virtualisant la table "archives") pour accélérer la recherche récursive, sans grande différence avec ma méthode précédente (avec un find récursif directement dans le "Tbl_archives").
Je me suis rendu compte bien après que c'est mon processus en écriture qui est interminable. Les pistes que j'ai actuellement en tête sont :
1/ Populer, lors de la boucle, un tableau qui viendra, une fois arrivé en fin de boucle se patcher dans les commentaires de la colonne "H". Je sais le faire directement dans la colonne "H", je doute que cela soit possible de la même manière dans les commentaires de ces cellules, évidemment sans passer par une boucle et un long processus d'écriture. Voici donc ma première interrogation ?
2/ Changement de stratégie mais là c'est de la haute couture et peut être super gourmand en ressources à chaque survol de la souris (et donc invivable) : à chaque survol de la souris donc, et sur chaque cellule de la colonne H, lancer l'affichage d'un commentaire dynamique permettant de boucler sur l'historique en question. Même pas certain de cette possibilité. Voici donc ma seconde interrogation ?
Bref l'idée est d'éviter le plan du "je sélectionne ma ligne et je clique sur un bouton pour afficher ledit commentaire". En revanche je suis à l'écoute de toute autre idée d'intégration sympathique, suggestion, remarque...
Option Explicit
Sub Lookup_comments()
'*** Objectif : Donne un historique de chaque cadence archivée via un
'*** commentaire visible par survol dans le tableur encours
With Application:
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Dim ws_archives As Worksheet, ws_encours As Worksheet
Dim lstoE As ListObject, lstoA As ListObject
Dim frstrow%, lastrow%
Dim i%, j%
Dim findA_row%
Dim cmt_yr As String, cmt_wk As String, cmt_dat As String, cmt_qte As String
Dim cmt_liv As String, cmt_cmt As String, cmt_rel As String, cmt_not As String
Dim commentaire As String
Dim existe As Boolean
Dim Rng, cle, clebis, p
Dim dico As Object
Barre_progression.afficher
Barre_progression.actualiser "Formatage de l'encours", _
CInt(4)
With ThisWorkbook
Set ws_archives = .Worksheets("Archives")
Set ws_encours = .Worksheets("EnCours")
End With
Set lstoE = ws_encours.ListObjects("Tbl_encours")
frstrow = lstoE.HeaderRowRange(1).Row + 1
lastrow = Cells(lstoE.HeaderRowRange(1).Row, lstoE.ListColumns(1).Index).End(xlDown).Row
Set lstoA = ws_archives.ListObjects("Tbl_archives")
Rng = lstoA.DataBodyRange.Value
Set dico = CreateObject("Scripting.Dictionary")
For j = LBound(Rng) To UBound(Rng)
dico.Add Key:=Rng(j, 18), _
Item:=Array(Rng(j, 1), Rng(j, 2), Rng(j, 10), Rng(j, 11), Rng(j, 14), _
Rng(j, 15), Rng(j, 16), Rng(j, 17), Rng(j, 19))
'1,2,10,11,14:yr,wk,qte,liv,dat
'15,16,17:comm,datrelanc,noteint
'19:previous
Next j
'Insertion commentaires semaine(s) passée(s)
For i = frstrow To lastrow
Barre_progression.actualiser "Formatage de l'encours", _
CInt(5 + (i / lastrow) * 94)
commentaire = ""
existe = False
cle = ws_encours.Cells(i, 27).Value
Do While dico.exists(cle)
If dico(cle)(8) = "!" Then
existe = True
findA_row = lstoA.ListColumns(18).DataBodyRange.Find(what:=cle, _
LookAt:=xlWhole).Row
commentaire = commentaire & vbLf & vbLf & _
"Erreur : contrôlez la ligne " & findA_row & " de l'onglet Archives"
dico.Remove (cle)
ElseIf IsNumeric(dico(cle)(8)) Then
existe = True
cmt_yr = dico(cle)(0): cmt_wk = dico(cle)(1)
cmt_qte = dico(cle)(2): cmt_liv = dico(cle)(3): cmt_dat = dico(cle)(4)
cmt_cmt = dico(cle)(5): cmt_rel = dico(cle)(6): cmt_not = dico(cle)(7)
commentaire = commentaire & vbLf & vbLf & _
cmt_yr & ".S" & Right("0" & cmt_wk, 2) & " :" & vbLf & _
cmt_qte & " pièce(s) à livrer au " & cmt_dat & " (" & cmt_liv & " reçue(s))" & vbLf & _
"Date dernière relance : " & cmt_rel & vbLf & _
"Commentaire : " & cmt_cmt & vbLf & _
"Note interne : " & cmt_not
clebis = cle: cle = dico(cle)(8)
dico.Remove (clebis)
Else
dico.Remove (cle)
End If
Loop
For j = 1 To Len(commentaire)
If Mid(commentaire, j, 1) <> Chr(10) Then Exit For
Next j
commentaire = Mid(commentaire, j)
'c'est cette partie de suppression/écriture qui est trop lente
If existe Then
With ws_encours.Range("H" & i)
.ClearComments
.AddComment
.Comment.Text Text:=commentaire
' With .Comment.Shape
' .AutoShapeType = msoShapeRoundedRectangle
' .TextFrame.AutoSize = True
' .OLEFormat.Object.Font.Name = "Tverdana"
' .OLEFormat.Object.Font.Size = 11
' .OLEFormat.Object.Font.FontStyle = "Normal"
' End With
' p = InStr(.Comment.Text, "Erreur : contrôlez la ligne")
' If p > 0 Then
' .Comment.Shape.TextFrame.Characters(Start:=p, Length:=Len("Erreur :")).Font.ColorIndex = 3
' .Comment.Shape.TextFrame.Characters(Start:=p, Length:=Len("Erreur :")).Font.Bold = True
' .Comment.Visible = True
' End If
End With
End If
Next i
Barre_progression.actualiser "", CInt(100)
With Application:
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub[s=co-c0504d][/s]
Bonsoir,
je n'ai pas tout compris mais voici le résultat de 2 tests :
Un chrono du début à la fin du code = entre 6 et 7 secondes
En supprimant la progresse barre = entre 1 et 2 secondes
je me lance dans les essais en supprimant les lignes sous commentaire...
@ bientôt
LouReeD
Oui avec cette partie du code :
@ bientôt
LouReeD
bonjour tomato, slaut LouReeD,
la macro ecrit les commentaire maintenant dans le même tableau mais la colonne "Commentaire" (colonne AB)
si vous sélectez la colonne H, on vous montre ce commentaire dans un shape.
Ceci est mieux, non ?
Juste deux lignes à mette en commentaire :
' .ClearComments
' .AddComment
en effet les accès feuilles entre VBA et Excel sont "très" lourds dans le fonctionnement d'un code, comme ici vous en faites deux et qui plus est vous faites une suppression d'objet, puis une création cela ralenti énormément VBA. Vous que vous remplacez le texte existant d'un commentaire par un autre, pourquoi tout supprimer ? Juste le texte est à modifier.
Il faut juste vérifier que la cellule comporte bien un commentaire, si oui on remplace le code, sinon on crée le commentaire :
If existe Then
With ws_encours.Range("H" & i)
' .ClearComments
' .AddComment
Dim YATILCommentaire As Comment
Set YATILCommentaire = .Comment
If YATILCommentaire Is Nothing Then .AddComment
.Comment.Text Text:=Commentaire
With .Comment.Shape
.AutoShapeType = msoShapeRoundedRectangle
.TextFrame.AutoSize = True
.OLEFormat.Object.Font.Name = "Tverdana"
.OLEFormat.Object.Font.Size = 11
.OLEFormat.Object.Font.FontStyle = "Normal"
End With
p = InStr(.Comment.Text, "Erreur : contrôlez la ligne")
If p > 0 Then
.Comment.Shape.TextFrame.Characters(Start:=p, Length:=Len("Erreur :")).Font.ColorIndex = 3
.Comment.Shape.TextFrame.Characters(Start:=p, Length:=Len("Erreur :")).Font.Bold = True
.Comment.Visible = True
End If
End With
End IfCela donne 15 secondes environs si la colonne H ne contient aucun commentaires...
A voir
@ bientôt
LouReeD
Merci LouReeD et BsAlv pour vos retours et votre rapidité, moi je reste sans voix
Bref.
L'inconvénient LouReeD c'est que cette Tbl_encours est détruite/reconstruite chaque semaine. Ca rend la contrainte temps de suppression/creation d'objet incontournable. Merci pour l'avoir mis en évidence.
BsAlv j'aime bien l'idée et je pars volontiers dans cette direction. L'inconvénient cette fois doit se situer en le fauteuil et le clavier .. je n'arrive pas à passer le cap du
Set shp = Me.Shapes("MonCommentaire")qui me retourne une erreur de type pas content
Bref, comment créer et nommer ce shape s'il te plait ?
Je ne comprends pas l'idée "est détruite/reconstruite".
Mais c'est que je suis à côté de la plaque sans doute
@ bientôt
LouReeD
re, salut LouReeD,
avec cette macro, on ajoute le forme, s'il n'existe pas encore. Vous pouvez modifiez les couleurs et les dimensions.
J'ai aussi ajouté ce "Wraptext=false" dans votre macro
Bonjour, autrement une méthode dont le temps d'exécution serait instantané serait d'ajouter une colonne "commentaires" avec les remarques dans des cellules au lieux de commentaires. Cela permet d'écrire en 1 fois, comme le dit LooReeD c'est bien la boucle cellule par cellule (dans la solution actuelle, je n'ai pas regardé BsAlv, salut
Pour l'histoire de la suppression de commentaires je reste comme LooReeD, pas trop compris. Ou bien tout supprimer avec les commentaires (en 1 instruction), ou bien effectuer ce petit test comme proposé.
Edit : je viens de voir stupidement que c'était la méthode proposé par BsAlv, je m'était concentré sur les shapes sans voir mention de la colonne. Au final nous avons bien la meme idée
BsAlv c'est parfait merci
Hello saboh12617
LouReeD, j'ai d'autres macros qui forment une routine hebdomadaire : actualise la table en supprimant entièrement son contenu (clearcontents) avant d'y transférer les datas "neuves"
Merci vous tous
EDIT Modo : modifié titre du sujet (Un truc super long ... oui ça compte). Merci de mettre un titre en rapport avec votre demande