Recherche de données dans 1000+ fichiers [Résolu/Fermé]

Signaler
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018
-
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018
-
Chers tous,

Je me retrouve avec un travail assez laborieux à effectuer. J’ai un fichier Excel récapitulatif (voir exemple.xlsx) reprenant en colonne A « Filename » les noms de +/- 1000 autres fichiers excel (présent dans le même répertoire).

Ce fichier récapitulatif comprend également une série d’autres colonnes portant des noms spécifiques (pour l’exemple, B1= X, C1 = Y et D1 = Z)

Les 1000 fichiers de données (voir example2.xlsx) se composent comme suit : la colonne B contient une suite de lettre majuscule de longueur variable et d’ordre variable (mais unique) et la colonne C contient les valeurs qui m’intéressent.

J’aimerai à partir du fichier récapitulatif, créer une macro qui ouvrirait les uns à la suite des autres les 1000 fichiers et chercherait dans la colonne B de ceux-ci les valeurs X, Y et Z (les unes après les autres) et me rapportent les valeurs correspondantes de la colonne C dans le fichier récapitulatif.

Pour l’heure, je procède manuellement avec une formule vlookup et différentes procédures manuelles mais ce n’est vraiment pas efficace.

Auriez-vous des indications, pistes ou commentaires ? Toute aide serait grandement appréciée !

Pour télécharger les exemples, voici un lien : https://fromsmash.com/exemple-Macro

Merci beaucoup

CL


1 réponse

Messages postés
10460
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 avril 2020
589
bonsoir, je suis un peu déçu par les deux fichiers exemples.
dis-toi bien que nous avons tous intérêt à ce que tout soit le plus clair possible. toi pour obtenir ce dont tu as besoin, nous pour éviter du travail inutile.
peux-tu donc faire un effort de réalisme, par exemple avec les noms des fichiers en colonne A, et y ajouter un troisième fichier qui montre à quoi ressemblera le fichier récapitulatif à la fin du traitement?
peux-tu aussi décrire ton expérience en VBA? cherches-tu des pistes, ou un travail tout fait?
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

Un petite précision : Disons que j'ai les valeurs d'une trentaine de variables différentes à aller chercher dans les fichiers de données, est-ce faisable/optimal de répéter la procédure suivante 34 fois pour autant que j'ai défini crit1 à crit 34 as String ?

Select Case skey
Case Is = crit1
fdest.Cells(dlig, 2) = sval
Messages postés
10460
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 avril 2020
589 >
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

je pense que c'est faisable. une première optimisation serait de travailler avec des critères numériques plutôt que des chaînes de caractères.
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018
>
Messages postés
10460
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 avril 2020

Voici ce que j'utilise et ça m'a l'air de fonctionner !

Il y a certainement moyen d'optimiser mais c'est fonctionnel :p

Option Explicit

Sub cletess()
Dim wb As Workbook
Dim fdest As Worksheet, fsource As Worksheet
Dim dlig As Long
Dim sfich As String
Dim srow As Range
Dim crit1$, crit2$, crit3$, crit4$, crit5$, crit6$, crit7$, crit8$, crit9$, crit10$, crit11$, crit12$, crit13$, crit14$, crit15$, crit16$, crit17$, crit18$, crit19$, crit20$, crit21$, crit22$, crit23$, crit24$, crit25$, crit26$, crit27$, crit28$, crit29$, crit30$, crit31$, crit32$, crit33$, crit34$
Dim skey, sval, cpath As String

cpath = ThisWorkbook.Path & "\"
Set fdest = ActiveSheet
crit1 = fdest.Cells(1, 34)
crit2 = fdest.Cells(1, 35)
crit3 = fdest.Cells(1, 36)
crit4 = fdest.Cells(1, 37)
crit5 = fdest.Cells(1, 38)
crit6 = fdest.Cells(1, 39)
crit7 = fdest.Cells(1, 40)
crit8 = fdest.Cells(1, 41)
crit9 = fdest.Cells(1, 42)
crit10 = fdest.Cells(1, 43)
crit11 = fdest.Cells(1, 44)
crit12 = fdest.Cells(1, 45)
crit13 = fdest.Cells(1, 46)
crit14 = fdest.Cells(1, 47)
crit15 = fdest.Cells(1, 48)
crit16 = fdest.Cells(1, 49)
crit17 = fdest.Cells(1, 50)
crit18 = fdest.Cells(1, 51)
crit19 = fdest.Cells(1, 52)
crit20 = fdest.Cells(1, 53)
crit21 = fdest.Cells(1, 54)
crit22 = fdest.Cells(1, 55)
crit23 = fdest.Cells(1, 56)
crit24 = fdest.Cells(1, 57)
crit25 = fdest.Cells(1, 58)
crit26 = fdest.Cells(1, 59)
crit27 = fdest.Cells(1, 60)
crit28 = fdest.Cells(1, 61)
crit29 = fdest.Cells(1, 62)
crit30 = fdest.Cells(1, 63)
crit31 = fdest.Cells(1, 64)
crit32 = fdest.Cells(1, 65)
crit33 = fdest.Cells(1, 66)
crit34 = fdest.Cells(1, 67)

dlig = 2

sfich = fdest.Cells(dlig, 1)

Do While sfich <> ""
Set wb = Workbooks.Open(cpath & sfich & ".xlsx")
Set fsource = wb.Sheets(1)
For Each srow In fsource.UsedRange.Rows
skey = srow.Cells(1, 2)
sval = srow.Cells(1, 3)
Select Case skey
Case Is = crit1
fdest.Cells(dlig, 34) = sval
Case Is = crit2
fdest.Cells(dlig, 35) = sval
Case Is = crit3
fdest.Cells(dlig, 36) = sval
Case Is = crit4
fdest.Cells(dlig, 37) = sval
Case Is = crit5
fdest.Cells(dlig, 38) = sval
Case Is = crit6
fdest.Cells(dlig, 39) = sval
Case Is = crit7
fdest.Cells(dlig, 40) = sval
Case Is = crit8
fdest.Cells(dlig, 41) = sval
Case Is = crit9
fdest.Cells(dlig, 42) = sval
Case Is = crit10
fdest.Cells(dlig, 43) = sval
Case Is = crit11
fdest.Cells(dlig, 44) = sval
Case Is = crit12
fdest.Cells(dlig, 45) = sval
Case Is = crit13
fdest.Cells(dlig, 46) = sval
Case Is = crit14
fdest.Cells(dlig, 47) = sval
Case Is = crit15
fdest.Cells(dlig, 48) = sval
Case Is = crit16
fdest.Cells(dlig, 49) = sval
Case Is = crit17
fdest.Cells(dlig, 50) = sval
Case Is = crit18
fdest.Cells(dlig, 51) = sval
Case Is = crit19
fdest.Cells(dlig, 52) = sval
Case Is = crit20
fdest.Cells(dlig, 53) = sval
Case Is = crit21
fdest.Cells(dlig, 54) = sval
Case Is = crit22
fdest.Cells(dlig, 55) = sval
Case Is = crit23
fdest.Cells(dlig, 56) = sval
Case Is = crit24
fdest.Cells(dlig, 57) = sval
Case Is = crit25
fdest.Cells(dlig, 58) = sval
Case Is = crit26
fdest.Cells(dlig, 59) = sval
Case Is = crit27
fdest.Cells(dlig, 60) = sval
Case Is = crit28
fdest.Cells(dlig, 61) = sval
Case Is = crit29
fdest.Cells(dlig, 62) = sval
Case Is = crit30
fdest.Cells(dlig, 63) = sval
Case Is = crit31
fdest.Cells(dlig, 64) = sval
Case Is = crit32
fdest.Cells(dlig, 65) = sval
Case Is = crit33
fdest.Cells(dlig, 66) = sval
Case Is = crit34
fdest.Cells(dlig, 67) = sval
End Select
Next srow
wb.Close
dlig = dlig + 1
sfich = fdest.Cells(dlig, 1)
Loop
End Sub
Messages postés
10460
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 avril 2020
589 >
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

un peu plus élégant à lire et à écrire, mais pas vraiment optimisé (ni testé):
'en remplacement de tous les dim crit$
Dim crit(34) As String
Dim i As Integer

'en remplacement de tous les crit = fdest.Cells(1, )
For i = 1 To 34
    crit(i) = fdest.Cells(1, 33 + i)
Next i

'en remplacement du select case ... end case
        For i = 1 To 34
            If skey = crit(i) Then
                fdest.Cells(dlig, 33 + i) = sval
                Exit For
            End If
        Next i
Messages postés
38
Date d'inscription
jeudi 10 janvier 2013
Statut
Membre
Dernière intervention
5 avril 2018

C'est beaucoup plus digeste en effet et ça fait tout à fait sens, merci beaucoup pour votre temps !