Bonjour à tous,
Je m'excuses par avance d'ouvrir une nouvelle discussion sur l'optimisation de code VBA, mais ma question porte plutôt sur : pourquoi ma modification n'améliore pas le temps d'exécution de ma macro ?
Le contexte est que ma macro liste tous les fichiers d'une arborescence. Or cette arborescence est souvent très lourde avec plusieurs dizaines de milliers de fichiers.
J'avais un programme comme base de travail, je vous montre ici la fonction intéressante qui récursivement va chercher tous les fichiers :
La partie intéressante est que chaque cellule de la feuille est modifier une par une. Or selon mes recherches ceci pourrait expliqué la lenteur du programme. J'ai donc modifier cette fonction pour arriver à ça :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 Private Function ScanFolder(FolderName As String) Dim oFSO As Scripting.FileSystemObject Dim ObjDossier As Object Dim ElementFichier As File Dim ElementDossier As Folder Dim ligne As Integer Dim Taille As Long Dim nomFic As String Dim dossierFic As String Dim typeFic As String Dim dateModif As Date Set oFSO = New Scripting.FileSystemObject For Each ElementFichier In oFSO.GetFolder(FolderName).Files If Range("A4").End(xlDown).Row > 65500 Then ligne = 5 Else ligne = Range("A4").End(xlDown).Row + 1 End If nomFic = ElementFichier.Name dossierFic = ElementFichier.ParentFolder & "\" typeFic = ElementFichier.Type Taille = Round(ElementFichier.Size / 1024, 2) dateModif = ElementFichier.DateLastModified Range("A" & ligne).Value = nomFic Range("B" & ligne).Value = "Ouvrir" Range("C" & ligne).Value = dossierFic Range("D" & ligne).Value = typeFic If Taille < 1024 Then Range("E" & ligne).Value = Taille & " Ko" Else Range("E" & ligne).Value = Round(Taille / 1024, 2) & " Mo" End If Range("F" & ligne).Value = dateModif Next ElementFichier For Each ElementDossier In oFSO.GetFolder(FolderName).SubFolders ScanFolder ElementDossier.Path Next ElementDossier End Function
Je passe en paramètre de cette fonction un tableau dynamique de deux dimensions. La fonction ne modifie donc que ce tableau et ensuite à la toute fin va recopier le tableau sur la feuille.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 Private Function ScanFolder(FolderName As String, tableau As Variant) Dim oFSO As Scripting.FileSystemObject Dim ElementFichier As File Dim ElementDossier As folder Dim ligne As Long Dim Taille As Long Dim tailleTab As Long Set oFSO = New Scripting.FileSystemObject For Each ElementFichier In oFSO.GetFolder(FolderName).files Taille = Round(ElementFichier.Size * 0.0009765625, 2) tailleTab = UBound(tableau, 2) tableau(0, tailleTab) = ElementFichier.Name tableau(2, tailleTab) = ElementFichier.ParentFolder & "\" tableau(3, tailleTab) = ElementFichier.Type If Taille < 1024 Then tableau(4, tailleTab) = Taille & " Ko" Else tableau(4, tailleTab) = Round(Taille * 0.0009765625, 2) & " Mo" tableau(5, tailleTab) = ElementFichier.DateLastModified ReDim Preserve tableau(8, tailleTab + 1) Next ElementFichier For Each ElementDossier In oFSO.GetFolder(FolderName).SubFolders ScanFolder ElementDossier.path, tableau Next ElementDossier Range("A5").Resize(UBound(tableau, 2), UBound(tableau, 1)) = Application.Transpose(tableau) Set oFSO = Nothing End Function
La fonction marche bien, mais théoriquement et à en croire de nombreux sites le gains de temps devrait être considérable puisqu'on passe de 6 modifications de feuille par fichier à une seule pour tout le programme.
Mais malheureusement je n'observe aucun gains de temps lors de l'exécution de la macro. Je viens donc vers vous afin de savoir si vous auriez une idée du pourquoi ? Si j'ai loupé quelque chose, ou mal compris.. Je n'en sais rien..
Quelques infos complémentaires :
- Les fichiers sont situés sur un serveur distant ce qui peut expliquer que l'exécution soit plus longue qu'en local, mais ça n'explique pas pourquoi ce temps ne diminu pas.
- J'ai essayé aussi beaucoup d'autres méthodes afin d'optimiser le temps (dont certaines que vous pouvez voir dans le code), mais ma question porte principalement sur la partie que je vous explique plus haut.
En tout cas merci d'avance pour votre aide,
Cordialement,
Partager