Accelérer déroulement macro

Résolu
sfab41 Messages postés 28 Date d'inscription vendredi 27 mars 2009 Statut Membre Dernière intervention 9 juillet 2009 - 26 mai 2009 à 23:37
sfab41 Messages postés 28 Date d'inscription vendredi 27 mars 2009 Statut Membre Dernière intervention 9 juillet 2009 - 28 mai 2009 à 07:36
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?

2 réponses

cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
27 mai 2009 à 00:45
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

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
sfab41 Messages postés 28 Date d'inscription vendredi 27 mars 2009 Statut Membre Dernière intervention 9 juillet 2009
28 mai 2009 à 07:36
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.
Rejoignez-nous