Accelerer petite boucle (partie de macro)

Bonjour à tous et merci à tous ceux qui vont prendre un peu de leur temps pour m'aider.

Petite présentation du problème:

J'ai créé un fichier EXCEL avec des USERFORM et des MACRO VBA.

Ce fichier va sur le réseau vérifier la présence de nouveaux fichiers et s'il en trouve, il les ouvre pour en récupérer des infos.

Jusque la tout fonctionne mais c'est lent.

Une petite partie de mon code met 15 secondes pour traiter environ 420 lignes (sans aucun accès réseau).

Je met donc ici mon code dans l'espoir de trouver une solution alternative et bien sur me faisant gagner du temps.

Application.ScreenUpdating = False
Application.EnableEvents = False
Dim wbFichierUsager As Workbook
Dim i As Long, m As Long

ActiveSheet.Paste

    Dim strFichierOK As Object, Fichier As String
    Set strFichierOK = CreateObject("scripting.dictionary")

    m = wbFichierUsager.Sheets("Fichiers").Range("A" & Rows.Count).End(xlUp).Row

Debug.Print "4 " & Now

    ' Supprimer les fichiers déjà traités
    For i = 1 To m
        Fichier = wbFichierUsager.Sheets("Fichiers").Cells(i, 1)
        strFichierOK(Fichier) = strFichierOK(Fichier) + 1
    Next i

Debug.Print "4a " & Now

    For i = 1 To m
        Fichier = wbFichierUsager.Sheets("Fichiers").Cells(i, 1)
        If strFichierOK(Fichier) > 1 Then
            wbFichierUsager.Sheets("Fichiers").Rows(i).Delete
            i = i - 1
            m = m - 1
        End If
    Next i

Debug.Print "5 " & Now

Application.ScreenUpdating = True
Application.EnableEvents = True

J'ai aussi essayé avec: Application.Calculation = xlManual puis Application.Calculation = xlAutomatic mais cela ne change rien.

Comment je sais que c'est cette partie qui me ralenti ? Simplement en me basant sur les messages "Debug" dont voici les résultats:

3 06/07/2017 11:01:17

4 06/07/2017 11:01:17

4a 06/07/2017 11:01:17

5 06/07/2017 11:01:32

Explication de comment procède mon fichier:

• EXCEL fait un listing du répertoire qui reçoit les fichiers à traiter
• Les noms de fichier sont stockés dans une feuille dédiée ("Fichiers") dans la colonne A
• Je copie ensuite les infos des fichiers déjà traités de ma page principale ("Infos") à la suite dans la feuille ("Fichiers")
• Ensuite je compte le nombre de fois que le nom de fichier apparait (partie entre les "debug 4" et "4a")
• Si le nom a été trouvé plusieurs fois (logiquement maximum 2) il supprime ce nom de la liste (partie situé entre "debug 4a" et "5")
• Plus loin, la macro se sert des noms restant pour ouvrir et traiter les nouveaux fichiers.

J'ai supprimé les parties de code avant et après ce qui me semble utile étant donné que c'est cette unique partie qui me pose problème.

Bien sur on peu passer par une autre solution que celle utilisée ci-dessus, mais je ne vois pas de quelle manière.

Cette méthode me semblait "logique" vu le peu de connaissance que j'ai en VBA, mais 15 seconds pour à peine 420 lignes, c'est beaucoup trop, parce que je suis sensé traiter bien plus de lignes par la suite.

Merci d'avance pour vos idées et conseils

Bon bah pas de réponse... Je suppose qu'il y a mieux mais j'ai quand même gagné beaucoup de temps en modifiant le code du post précédent de la manière suivante:

    ActiveSheet.Paste

    Dim strFichierOK As Object, Fichier As String
    Set strFichierOK = CreateObject("scripting.dictionary")

    m = wbFichierUsager.Sheets("Fichiers").Range("A" & Rows.Count).End(xlUp).Row

Debug.Print "4 " & Now

    ' Supprimer les fichiers déjà traités
    For i = 1 To m
        Fichier = wbFichierUsager.Sheets("Fichiers").Cells(i, 1)
        strFichierOK(Fichier) = strFichierOK(Fichier) + 1
    Next i

Debug.Print "4a " & Now

    j = 1
    For i = 1 To m
        Fichier = wbFichierUsager.Sheets("Fichiers").Cells(i, 1)
        If strFichierOK(Fichier) = 1 Then
            wbFichierUsager.Sheets("Fichiers").Cells(j, 2) = Fichier
            j = j + 1
        End If
    Next i
    wbFichierUsager.Sheets("Fichiers").Columns("A:A").Delete

Debug.Print "5 " & Now

Ce n'est sans doute pas parfait mais ça me permet de gagner pas loin de 15 secondes pour environ 420 fichiers à traiter.

1 07/07/2017 15:57:37

2 07/07/2017 15:57:37

3 07/07/2017 15:57:38

4 07/07/2017 15:57:38

4a 07/07/2017 15:57:38

5 07/07/2017 15:57:38

6 07/07/2017 15:57:38

A la place de supprimer les cellules une à une, je copie les noms qui ne sont pas en double dans la colonne B, puis je supprime simplement la colonne A. Mes infos sont donc toujours au bon endroit pour la suite de ma macro et je n'ai pas besoin de supprimer 840 cellules (420 noms de fichiers 2x puisque déjà traités), mais une seule colonne.

Je vais donc écouter ce que me souffle ce petit smiley:

Merci à ceux qui ont pris le temps de me lire.