Accelérer déroulement macro [Résolu]

Signaler
Messages postés
28
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
9 juillet 2009
-
Messages postés
28
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
9 juillet 2009
-
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

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
75
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)
Messages postés
28
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
9 juillet 2009

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.