Discussion :

[WalTT]

Bonjour à tous, je suis autodidacte en VBA et je vous sollicite pour m’aider à résoudre un problème.
J’ai un code qui liste les fichiers contenus dans un répertoire. Mais j’aimerai y apporter une amélioration, je m’explique.
Voilà mon code actuel :

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
Sub ListingFichiers()
Dim Rep As String, Fichier As String
Dim i As Integer
 
 
Rep = ThisWorkbook.Path & "\05-Commandes" & "\" 'Repertoir du fichier
 
 
Fichier = Dir(Rep)  'Nom du fichier dans le repertoir
 
 
 
 
Sheets("Synthése commandes").Range("A5:ZZ65000").ClearContents  'Effacer tout
 
i = 3
    Do While Fichier <> ""
 
 
 
        If Fichier Like "*.xlsx*" Then
        i = i + 1
 
            Sheets("Synthése commandes").Range("A" & 1 + i) = Fichier
        End If
        Fichier = Dir
 
    Loop
 
 
 
End Sub

Il me renvoi une liste de fichiers «Commandes»

C2406552-0-WS UNIBER (EV).xlsx
C2407563-0-WS SMCB (Bidul).xlsx
C2407563-A-WS SMCB (Bidul).xlsx
C2407564-0-WS RUBIV (Commerce).xlsx
C2407567-0-WS RUBIV (Raccord).xlsx
C2407575-0-WS IGAS (Truc).xlsx
C2407575-A-WS IGAS (Truc).xlsx
C2407582-0-WS EMP3 (machin).xlsx

Je souhait l’améliorer en gérant les indices.
-0- ou -A- ou -B- ….

Sur l’exemple ci-dessus, on voit des numéros de commandes en doublons.
Je souhaite que, lorsqu’il y a doublon, le code ne renvoi seulement les n° de commandes don l’indice est le plus élevé.

C’est-à-dire :

C2406552-0-WS UNIBER (EV).xlsx
C2407563-A-WS SMCB (Bidul).xlsx
C2407564-0-WS RUBIV (Commerce).xlsx
C2407567-0-WS RUBIV (Raccord).xlsx
C2407575-A-WS IGAS (Truc).xlsx
C2407582-0-WS EMP3 (machin).xlsx


Information importante, le n° de commande sont toujours structurés comme ceci :
C => Pour commande
24 l’année
07 le mois
123 N° chrono compris entre 001 et 9999 (3 ou 4 chiffres)
-0- Par défaut indice 0 mais si modifications, l’indice sera -A- puis -B- etc… (toujours encadré de tirets)
WS Initiales de l’auteur 2 ou 3 lettres
FOURNISSEUR x caractères


Merci d’avance pour vos propositions de solutions.

[ExcelTastic]

Bonjour WalTT

Mieux vaut utiliser FSO, voici une possibilité de code avec commentaires

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
44
Sub ListerFichiersDansRepertoire()
    Dim FSO As Object
    Dim Dossier As Object, Fichier As Object
    Dim CelFind As Range
    Dim CheminRep As String, Indice0 As String, Indice1 As String
    Dim i As Integer
    Dim DebNom As String
    ' Spécifiez le chemin du répertoire ici
    CheminRep = ThisWorkbook.Path & "\05-Commandes" & "\"
    ' Effacer la liste des fichiers précédemment trouvés
    With Sheets("Synthèse commandes")
      .Range("A2:Z" & Rows.Count).ClearContents
      ' Créer un objet FileSystemObject
      Set FSO = CreateObject("Scripting.FileSystemObject")
      ' Obtenir le dossier
      Set Dossier = FSO.GetFolder(CheminRep)
      ' Initialiser le compteur de ligne pour lister les fichiers
      i = 1
      ' Parcourir chaque fichier dans le dossier
      For Each Fichier In Dossier.Files
        DebNom = Left(Fichier.Name, 8): Indice0 = Mid(Fichier.Name, 10, 1)
        ' Vérifier si début nom fichier n'existe pas déjà
        Set CelFind = .Range("A:A").Find(What:=DebNom, LookIn:=xlValues, LookAt:=xlPart, _
          SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        ' Si trouvé
        If Not CelFind Is Nothing Then
          ' Vérifier l'indice
          Indice1 = Mid(CelFind.Value, 10, 1)
          If Indice0 > Indice1 Then
            ' Si indice supérieur, remplacer le nom du fihcier
            CelFind = Fichier.Name
          End If
        Else
          ' Ecrire le nom du fichier dans la cellule de la feuille active
          .Cells(i, 1).Value = Fichier.Name
          i = i + 1
        End If
      Next Fichier
    End With
    ' Libérer les objets
    Set Fichier = Nothing
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

A Tester

[fraflt69]

Bonsoir WalTT,
Quand tu listes tes fichiers on croit qu'ils sont triés par une procédure : en fait c'est l'ordre de création qui le veut sans doute
sinon une commande dos du type Dir /B /OS *-?-*.xlsx >fichier_resultat donne la liste des fichiers et même sans utiliser FSO
Le Dos permet aussi de trier sort <fichier_resultat >fichier_trié
Il suffit d'appeler ShellExecute pour lancer les 2 commandes en VBA.

Bonsoir ExcelTastic
Ta procedure qui utilise FSO est une bonne idée, mais je ne comprend pas le find alors que la feuille excel n'est pas remplie.
Le besoin est de 1) remplir la liste des fichiers 2) extraire les elements d'indice le plus élevé pour chaque triplet (année, mois, chrono)
Attention le chrono peut être sur 3 ou 4 caractères, je suggère de remplacer!
DebNom = Left(Fichier.Name, 8): Indice0 = Mid(Fichier.Name, 10, 1)
Par
Dim TablPrecedent(3) As String ' voir TablPrecedent(10) si il y avait des fichiers avec plus de 2 tirets (soit 9 tirets)
Dim TablCourant(3) As String

TablCourant= Split(Fichier.Name, "-")
DebNom = TablCourant(0)

Indice0= TablCourant(1)
le Indice1 c'est le TablCourant de l'élément suivant

Dans la boucle, il faudra sauvegarder le tableau courant dans le précédent pour reconnaitre un nouveau debut de nom de fichier (le triplet)
TabPrecedent(0) =TablCourant(0)
TabPrecedent(1) =TablCourant(1)
TabPrecedent(2)= TablCourant(2)
là je ne suis pas sur de me faire comprendre....

[ExcelTastic]

Bonsoir

Petit rappel de la demande
"Je souhaite que, lorsqu’il y a doublon, le code ne renvoi seulement les n° de commandes don l'indice est le plus élevé."

Donc le find est utilisé pour garder le nom de fichier avec le plus grand indice 😜

Je ne m'embête pas, je vérifie si le début du fichier existe déjà et si oui l'inscris le nom avec le plus grand indice dans la cellule trouvée

Voilà

[WalTT]

J'aime bien cette piste.

Mais comme dit plus haut, je doute que le code classe les indices par ordre alphabétique.
A tester...

Bonsoir

Petit rappel de la demande
"Je souhaite que, lorsqu’il y a doublon, le code ne renvoi seulement les n° de commandes don l'indice est le plus élevé."

Donc le find est utilisé pour garder le nom de fichier avec le plus grand indice 😜

Je ne m'embête pas, je vérifie si le début du fichier existe déjà et si oui l'inscris le nom avec le plus grand indice dans la cellule trouvée

Voilà

[WalTT]

Merci pour la réponse.

Je n'ai pas tout compris, j'ai sans dout mal exprimé ma demande, alors je reformule autrement.

Je souhaite en réalité:

1) Traiter dans le dossier en question uniquement les .xls
2) Isoler le début du nom (tout ce qui est à gauche du premier tiret C2407123 ou C24071234
3) Si il y a doublon on regarde l'indice (ce qui est contenu entre les 2 tirets) 0 ou A ou B....
4) On inscrit dans ma feuille le nom complet du fichier don l'indice est le plus élevé

PS: je me fiche du classement

Bonsoir WalTT,
Quand tu listes tes fichiers on croit qu'ils sont triés par une procédure : en fait c'est l'ordre de création qui le veut sans doute
sinon une commande dos du type Dir /B /OS *-?-*.xlsx >fichier_resultat donne la liste des fichiers et même sans utiliser FSO
Le Dos permet aussi de trier sort <fichier_resultat >fichier_trié
Il suffit d'appeler ShellExecute pour lancer les 2 commandes en VBA.

Bonsoir ExcelTastic
Ta procedure qui utilise FSO est une bonne idée, mais je ne comprend pas le find alors que la feuille excel n'est pas remplie.
Le besoin est de 1) remplir la liste des fichiers 2) extraire les elements d'indice le plus élevé pour chaque triplet (année, mois, chrono)
Attention le chrono peut être sur 3 ou 4 caractères, je suggère de remplacer!
DebNom = Left(Fichier.Name, 8): Indice0 = Mid(Fichier.Name, 10, 1)
Par
Dim TablPrecedent(3) As String ' voir TablPrecedent(10) si il y avait des fichiers avec plus de 2 tirets (soit 9 tirets)
Dim TablCourant(3) As String

TablCourant= Split(Fichier.Name, "-")
DebNom = TablCourant(0)

Indice0= TablCourant(1)
le Indice1 c'est le TablCourant de l'élément suivant

Dans la boucle, il faudra sauvegarder le tableau courant dans le précédent pour reconnaitre un nouveau debut de nom de fichier (le triplet)
TabPrecedent(0) =TablCourant(0)
TabPrecedent(1) =TablCourant(1)
TabPrecedent(2)= TablCourant(2)
là je ne suis pas sur de me faire comprendre....

[ExcelTastic]

Bonjour WalTT

Mon code fait exactement ce que vous demandez, sauf pour les nouvelles informations...

1) ligne 29, quand on sélection l'indice le plus élevé, il faut savoir que l'indice 0 est par défaut. Puis ce sera A, puis B...
Le code va t'il classer dans l'ordre alphabétique?
Sinon il faut prévoir un truc du genre
Si indice 0 => valeur 0
SI indice A => valeur 1
Si indice B => valeur 2

Non pas besoin, 0 < A < B < Etc..
Je liste chaque fichier et je récupère leur indice (indice0)
Je vérifie dans la liste des fichiers trouvés et inscrits dans la feuille, si le début du fichier n'existe pas
S'il existe et si l'indice est plus élevé, j'écrase le contenu de la cellule avec le nouvel indice

2)Dans le dossier en question, pour chaque fichier .xls il y a sa version .pdf
Dans mon code je sélectionne uniquement le .xls

Avec FSO, il faut ajouter un test mais rien de bien compliqué

3) Le début du nom du fichier peut avoir 8 ou 9 caractère.
C'est pour ça que dans mon code je recherche la position du premier tiret afin d'en déduire le nombre de charactères à conserver.

Il faut donc chercher le tiret

Voici le code modifié à cet effet

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
44
45
46
47
48
49
50
51
Sub ListerFichiersDansRepertoire()
    Dim FSO As Object
    Dim Dossier As Object, Fichier As Object
    Dim CelFind As Range
    Dim CheminRep As String, Indice0 As String, Indice1 As String
    Dim i As Integer
    Dim DebNom As String
    ' Spécifiez le chemin du répertoire ici
    CheminRep = ThisWorkbook.Path & "\05-Commandes" & "\"
    ' Effacer la liste des fichiers précédemment trouvés
    With Sheets("Synthèse commandes")
      .Range("A:Z").ClearContents
      ' Créer un objet FileSystemObject
      Set FSO = CreateObject("Scripting.FileSystemObject")
      ' Obtenir le dossier
      Set Dossier = FSO.GetFolder(CheminRep)
      ' Initialiser le compteur de ligne pour lister les fichiers
      i = 1
      ' Parcourir chaque fichier dans le dossier
      For Each Fichier In Dossier.Files
        ' On ne traite pas les PDF
        If UCase(Right(Fichier.Name, 3)) = "PDF" Then GoTo SuiteFichier
        ' Début du nom jusqu'au tiret
        DebNom = Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1)
        ' Indice après le tiret
        Indice0 = Mid(Fichier.Name, Len(DebNom) + 2, 1)
        ' Vérifier si début nom fichier n'existe pas déjà
        Set CelFind = .Range("A:A").Find(What:=DebNom, LookIn:=xlValues, LookAt:=xlPart, _
          SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        ' Si trouvé
        If Not CelFind Is Nothing Then
          ' Récupérer l'indice du nom dans la cellule trouvée
          Indice1 = Mid(CelFind.Value, InStr(1, CelFind, "-") + 1, 1)
          ' Comparer les 2 indices
          If Indice0 > Indice1 Then
            ' Si indice supérieur, remplacer le nom du fihcier
            CelFind = Fichier.Name
          End If
        Else
          ' Ecrire le nom du fichier dans la cellule de la feuille active
          .Cells(i, 1).Value = Fichier.Name
          i = i + 1
        End If
SuiteFichier:
      Next Fichier
    End With
    ' Libérer les objets
    Set Fichier = Nothing
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

A+

[WalTT]

Merci ExcelTastic

Super, j'ai l'impression que ça rempli bien mon cahier de charges.
Ma feuille se complète bien avec chaque nom de fichier Excel et le code sélectionne bien l'indice le plus élevé.
J'aimerai tant savoir faire ça! lol

Seul bémol, un plantage lorsqu'on arrive au dernier fichier du répertoire.

Au niveau de la ligne 24 "DebNom = Left..."
"Argument ou apple de procédure incorect"

Bonjour WalTT

Mon code fait exactement ce que vous demandez, sauf pour les nouvelles informations...


Non pas besoin, 0 < A < B < Etc..
Je liste chaque fichier et je récupère leur indice (indice0)
Je vérifie dans la liste des fichiers trouvés et inscrits dans la feuille, si le début du fichier n'existe pas
S'il existe et si l'indice est plus élevé, j'écrase le contenu de la cellule avec le nouvel indice


Avec FSO, il faut ajouter un test mais rien de bien compliqué


Il faut donc chercher le tiret

Voici le code modifié à cet effet

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
44
45
46
47
48
49
50
51
Sub ListerFichiersDansRepertoire()
    Dim FSO As Object
    Dim Dossier As Object, Fichier As Object
    Dim CelFind As Range
    Dim CheminRep As String, Indice0 As String, Indice1 As String
    Dim i As Integer
    Dim DebNom As String
    ' Spécifiez le chemin du répertoire ici
    CheminRep = ThisWorkbook.Path & "\05-Commandes" & "\"
    ' Effacer la liste des fichiers précédemment trouvés
    With Sheets("Synthèse commandes")
      .Range("A:Z").ClearContents
      ' Créer un objet FileSystemObject
      Set FSO = CreateObject("Scripting.FileSystemObject")
      ' Obtenir le dossier
      Set Dossier = FSO.GetFolder(CheminRep)
      ' Initialiser le compteur de ligne pour lister les fichiers
      i = 1
      ' Parcourir chaque fichier dans le dossier
      For Each Fichier In Dossier.Files
        ' On ne traite pas les PDF
        If UCase(Right(Fichier.Name, 3)) = "PDF" Then GoTo SuiteFichier
        ' Début du nom jusqu'au tiret
        DebNom = Left(Fichier.Name, InStr(1, Fichier.Name, "-") - 1)
        ' Indice après le tiret
        Indice0 = Mid(Fichier.Name, Len(DebNom) + 2, 1)
        ' Vérifier si début nom fichier n'existe pas déjà
        Set CelFind = .Range("A:A").Find(What:=DebNom, LookIn:=xlValues, LookAt:=xlPart, _
          SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        ' Si trouvé
        If Not CelFind Is Nothing Then
          ' Récupérer l'indice du nom dans la cellule trouvée
          Indice1 = Mid(CelFind.Value, InStr(1, CelFind, "-") + 1, 1)
          ' Comparer les 2 indices
          If Indice0 > Indice1 Then
            ' Si indice supérieur, remplacer le nom du fihcier
            CelFind = Fichier.Name
          End If
        Else
          ' Ecrire le nom du fichier dans la cellule de la feuille active
          .Cells(i, 1).Value = Fichier.Name
          i = i + 1
        End If
SuiteFichier:
      Next Fichier
    End With
    ' Libérer les objets
    Set Fichier = Nothing
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

A+

[WalTT]

Merci ExcelTastic pour ce retour intéressant

Je vais le tester demain matin.
Sinon, comme ça il y a quelque 3 choses qui m'interpellent:

1) ligne 29, quand on sélection l'indice le plus élevé, il faut savoir que l'indice 0 est par défaut. Puis ce sera A, puis B...
Le code va t'il classer dans l'ordre alphabétique?
Sinon il faut prévoir un truc du genre
Si indice 0 => valeur 0
SI indice A => valeur 1
Si indice B => valeur 2
...


2)Dans le dossier en question, pour chaque fichier .xls il y a sa version .pdf
Dans mon code je sélectionne uniquement le .xls

3) Le début du nom du fichier peut avoir 8 ou 9 caractère.
C'est pour ça que dans mon code je recherche la position du premier tiret afin d'en déduire le nombre de charactères à conserver.

Je vous tiens informé demain,
Merci beaucoup

Bonjour WalTT

Mieux vaut utiliser FSO, voici une possibilité de code avec commentaires

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
44
Sub ListerFichiersDansRepertoire()
    Dim FSO As Object
    Dim Dossier As Object, Fichier As Object
    Dim CelFind As Range
    Dim CheminRep As String, Indice0 As String, Indice1 As String
    Dim i As Integer
    Dim DebNom As String
    ' Spécifiez le chemin du répertoire ici
    CheminRep = ThisWorkbook.Path & "\05-Commandes" & "\"
    ' Effacer la liste des fichiers précédemment trouvés
    With Sheets("Synthèse commandes")
      .Range("A2:Z" & Rows.Count).ClearContents
      ' Créer un objet FileSystemObject
      Set FSO = CreateObject("Scripting.FileSystemObject")
      ' Obtenir le dossier
      Set Dossier = FSO.GetFolder(CheminRep)
      ' Initialiser le compteur de ligne pour lister les fichiers
      i = 1
      ' Parcourir chaque fichier dans le dossier
      For Each Fichier In Dossier.Files
        DebNom = Left(Fichier.Name, 8): Indice0 = Mid(Fichier.Name, 10, 1)
        ' Vérifier si début nom fichier n'existe pas déjà
        Set CelFind = .Range("A:A").Find(What:=DebNom, LookIn:=xlValues, LookAt:=xlPart, _
          SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        ' Si trouvé
        If Not CelFind Is Nothing Then
          ' Vérifier l'indice
          Indice1 = Mid(CelFind.Value, 10, 1)
          If Indice0 > Indice1 Then
            ' Si indice supérieur, remplacer le nom du fihcier
            CelFind = Fichier.Name
          End If
        Else
          ' Ecrire le nom du fichier dans la cellule de la feuille active
          .Cells(i, 1).Value = Fichier.Name
          i = i + 1
        End If
      Next Fichier
    End With
    ' Libérer les objets
    Set Fichier = Nothing
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

A Tester