Accelérer déroulement macroRésolu

Question

Bonjour! Une nouvelle fois je fais appel à ce forum pour m'aider à résoudre mes petits problèmes. Voici donc le dernier en date: j'ai réalisé une macro (avec un coup de main de "bigfish" que je remercie encore). Seulement elle demande quelques actions un peu particulières mais nécessaires qui la rendent longue (plusieurs minutes). Code: Private Sub UserForm_Activate() 'Vérifie que toutes les vidéos inscrites dans la liste sont enregistrées, puis compte ceux présentes 'dans le dossier source et compare avec le compte obtenu avec la liste Dim objShell As Object, strFileName As Object Dim objFolder As folder Dim source Dim Compteur As Double Dim max source = GetSetting("Mes paramètres", "Label1", "Valeur Label1") max = GetSetting("Mes paramètres", "Textbox1", "Valeur Textbox1") + 7 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.NameSpace(source) Compteur = 0 Application.ScreenUpdating = False For Each cell In Range("D8:D" & max) If Not IsEmpty(cell) Then Compteur = Compteur + 1 Next ProgressBar1.Min = 0 ProgressBar1.max = Compteur With Worksheets(1) For Each cell In Range("D8:D" & Compteur) If Dir$(source & "" & cell.Value & ".asf") = "" Then cell.ClearContents If Dir$(source & "" & cell.Value & ".asf") <> "" Then If FileDateTime(source & "" & cell.Value & ".asf") <> cell.Offset(0, -2).Value Then If Not IsEmpty(cell.Offset(0, -2)) Then cell.Offset(0, -2).ClearContents If Not IsEmpty(cell.Offset(0, 2)) Then cell.Offset(0, 2).ClearContents If Not IsEmpty(cell.Offset(0, 3)) Then cell.Offset(0, 3).ClearContents End If End If ProgressBar1.Value = ProgressBar1.Value + 1 DoEvents Next End With Unload UserForm1 Application.ScreenUpdating = True Comptage2_vidéos End Sub Y aurait-il moyen de l'écourter? J'ai par ailleurs remarqué, grâce à la progressbar, que la macro sur une vingtaine de cellules est quasi instantanée mais qu'à partir de là cela devient très lent. Une idée du pourquoi de ce phénomène?

cs_Jack · Accepted Answer

Salut Question : Quand tu comptes le nombre de cellules non vides, est-ce que tu sous-entends que les cellules vides sont toutes à la fin ? Si ce n'est pas le cas, cela pose problème : -1- Tu comptes le nombre de cellules non vides "Compteur" sur la quantité totale "max" -2- Ensuite, tu traites uniquement les cellules de 8 à "Compteur" Cela ne semble pas logique : parmi ces cellules, certaines sont (peut-être) vides, et celles ignorées (entre Compteur et Max) contiennent peut-être des données --> La boucle après le "With Worksheets(1)" devrait, elle aussi, aller de 8 à "max" --> Et, pour chaque cellule, revérifier qu'elle soit vide avant de commencer tes tests --> For Each cell In Range("D8:D" & Compteur) If Not IsEmpty(cell) Then If Dir$(source & "" & cell.Value & ".asf") ........ Ensuite, à l'intérieur de cette dernière boucle : Premier test : tu compares If Dir$(source & "" & cell.Value & ".asf") = "" Then puis, en dessus ... <> "" Then Il faut utiliser Else : If Dir$(source & "" & cell.Value & ".asf") = "" Then cell.ClearContents Else If FileDateTime(source & "" & cell.Value & ".asf") <> cell.Offset(0, -2).Value Then Ensuite, tu as 3 comparaisons inutiles : Tu effaces une cellule si elle contient quelque chose Pourquoi tester si elle contient quelque chose ? Supprime le contenu sans te poser la question + Plutôt que répéter 3 instructions portant sur 3 cellules, regarde si tu ne pourrais vider aussi entre -2 et +2 Dans ce cas, tu pourrais paut-être utiliser un Range plutôt qu'une seule cellule à chaque fois Je pense que cela devrait déjà alléger la bête. Vala Jack, MVP VB NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

sfab41 · Answer

Bon et bien j'ai repris le code en prenant en compte tes instructions jack et en effet ça allège un peu. Pour le reste, je me suis rendu compte que la lenteur ne venait pas de cette macro mais d'une méthode de tri automatique qui n'était plus adaptée et qui me mettait le bazar. Mon problème est une nouvelle fois résolu.  Merci de votre aide.

Accelérer déroulement macro

2 réponses

Votre réponse

Discussions similaires