Macro boucle de moin en moin rapide

Fermé
Vinse - 21 juin 2013 à 13:29
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 - 22 juin 2013 à 00:10
Bonjour,

J'utilise une macro pour extraire les titre des fichier dans un dossier,
La maccro dure en moyen 9s pour extraire les 16 000 fichier , mais plus j'utilise plus elle dure longtemp.10 min au lieu de 9s au bou de la 4 utilisation et je ne sais pas pourquoi.

Je n'ai pas trouvé de macro me permétant de sélectionné les fichier les plus récent rapidement.

Voici la macro


'Recupere les noms de fichiers d'un répertoire dans un tableau

Sub RecupNomFichier(ByVal Chemin As String, ByRef Tableau As Variant)
Dim Fichier As String
Dim Compteur As Integer
Dim LigneCompteur As Integer
Dim i As Integer 'index ligne feuille excel


'Chemin = Application.InputBox(Prompt:="Quel répertoire voulez-vous imprimer?")
Chemin = Range("A2")
Chemin = Chemin + "\*.*"
'Range("B1") = Chemin
Compteur = 1
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
ReDim Preserve Tableau(Compteur)
Tableau(Compteur - 1) = Fichier
LigneCompteur = Compteur + 1
ActiveSheet.Range("B" & LigneCompteur).Value = Tableau(Compteur - 1)
Compteur = Compteur + 1
Fichier = Dir()
Loop
End Sub

Sub RecupFichierTableau()
On Error Resume Next
Application.ScreenUpdating = False
Dim Tableau() As String
Call RecupNomFichier(Chemin, Tableau)
FiltreAlpha
Columns("B:B").Select
Selection.Replace What:=".pdf", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("C1").Select
End Sub

Sub FiltreAlpha()

Columns("B:B").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
End With
With Selection
.HorizontalAlignment = xlRight
.Orientation = 0
End With
Range("B1").Select
End Sub
A voir également:

1 réponse

eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 254
22 juin 2013 à 00:10
Bonsoir,

La prochaine fois fourni un fichier de test exploitable avec les macros, plutôt que de coller en vrac ton code qu'on doit modifier pour pouvoir tester.
Je n'y ai pas vu de bizarreries, mais bon, je n'ai pas de répertoires avec 16000 pdf dedans non plus pour tester 4 fois...

Ici : https://www.developpez.net/forums/d200523/logiciels/microsoft-office/excel/contribuez/lister-fichiers-d-repertoire-feuille-excel/ , tu trouveras un autre code qui te permet de récupérer également les dates des fichiers. Il ira peut-être mieux.

eric
0