Recherche occurence dans plusieurs fichiers excell

trumanberic

XLDnaute Nouveau
Bonjour à toutes et tous :)


Alors, je suis totalement newbie pour commencer , donc désolé d'avance si cette question vous semble idiote....
Je viens d'être promu à mon boulot et je n'avais, dans le poste que j'occupais auparavant, absolument pas la nécessité d'utiliser Excell comme je dois l'utiliser aujourd'hui.
Je souhaiterais savoir s'il est possible, à travers un batch, script ou autre, la possibilité de chercher dans plusieurs fichiers Excell une occurence particulière. Dans un seul fichier, pas de pbe, je lance CTRL + F mais je perds bcp de temps chaque jour à devoir chercher des séries de nombres (de 14 chiffres) dans plusieurs fichiers excell, à devoir ouvrir les un après les autres (et fermer !) tous ces fichiers lorsque je cherche une occurence.

Existe il une option moins chronophage pour m'aider ?
 

trumanberic

XLDnaute Nouveau
Bonjour,

J'ai complété la demande dans ce dernier essai. Parfois les Dates sont des dates et parfois des textes "Date: 11/12/2018". La macro les retourne telle qu'elle les trouve à charge pour vous de faire le traitement adéquate (formule).

Le classeur joint fonctionne sur les classeurs y.xlsx et x.xlsx de son répertoire.

Bonne fin d'après-midi

Edit: Oups, j'avais laissé traîner un Stop de test dans la macro


Merci Mr. Roblochon, je crois que c'est exactement ce dont j'avais besoin, c'est parfait :))

Merci beaucoup !
 

job75

XLDnaute Barbatruc
Le fichier Z.xlsx du post #15 ne tient absolument pas la route !

Dans cette solution j'utilise le fichier X.xlsx du post #12 (commentaires en colonne D), il y a 3 Dictionary :
VB:
Sub Recherche()
Dim chemin$, fichier$, d1 As Object, d2 As Object, d3 As Object, w As Worksheet, tablo, nom$, i&, j&, x$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier)
            For Each w In .Worksheets
                tablo = w.UsedRange.Resize(, 4)
                nom = "#" & .Name & "#"
                For i = 1 To UBound(tablo)
                    x = CStr(tablo(i, 2))
                    If x Like "##############" Then
                        If InStr("#" & d1(x) & "#", nom) = 0 Then
                            d1(x) = IIf(d1(x) = "", "", d1(x) & "#") & .Name
                            For j = i To 1 Step -1
                                If IsDate(Right(tablo(j, 1), 8)) Then
                                    d2(x) = IIf(d2(x) = "", "", d2(x) & "#") & Right(tablo(j, 1), 8)
                                    Exit For
                                End If
                            Next j
                            d3(x) = IIf(d3(x) = "", "", d3(x) & "#") & tablo(i, 4) 'commentaire en colonne D
                        End If
                    End If
            Next i, w
            .Close
        End With
    End If
    fichier = Dir 'fichier suivant
Wend
'---restitution---
tablo = ActiveSheet.UsedRange.Resize(, 4)
For i = 2 To UBound(tablo)
    tablo(i, 2) = d1(CStr(tablo(i, 1)))
    If d2.exists(CStr(tablo(i, 1))) Then tablo(i, 3) = CDate(d2(CStr(tablo(i, 1)))) Else tablo(i, 3) = ""
    tablo(i, 4) = d3(CStr(tablo(i, 1)))
Next i
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
[A1].Resize(UBound(tablo), 4) = tablo
Columns.AutoFit 'ajustement largeur
End Sub
 

Pièces jointes

  • Résultat idéal(2).xlsm
    24.4 KB · Affichages: 20
  • X.xlsx
    21.6 KB · Affichages: 6

Discussions similaires