Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous :)

En voici une bonne pour ce début de semaine lol 🙃

Evidemment, je ne sais pas coder pour résoudre mon besoin !
Alors, je sollicite à nouveau nos chers ténors :

Voici le contexte de mon besoin :
NOUS TRAVAILLONS AVEC 3 FICHIERS ouverts généralement en même temps.

Les Professionnels que nous appelons sont difficiles à joindre.
Nous avons souvent des répondeurs et nous laissons un message.

Quand un Pro nous rappelle, NOUS DE DECROCHONS PAS.
Avant de rappeler nous vérifions à partir de quel fichier on a appelé pour savoir où nous en sommes avec le Pro.

Pour le rappeler il faut faire vite avant que le Pro ne soit à nouveau occupé.
Pour cela, il nous faut trouver très rapidement à partir de quel fichier nous avons appelé.

Nos 3 fichiers sont identiques et nous commençons toujours nos recherches par la feuille Appels,
Le besoin
Partant du principe que nos 3 fichiers sont généralement ouverts en même temps (mais ce n'est pas toujours le cas) :
Est-il possible si la recherche ne trouve rien dans la feuille active (Appels) du fichier actif que la recherche :
si pas trouvé que la recherche propose de chercher dans le fichier suivant (ouvert) ? :
1647274113301.png

Les noms des fichiers sont toujours les mêmes sauf la date qui change.
isiTel_lionel_fichier1 2022 03 14
isiTel_lionel_fichier2 2022 03 14
isiTel_lionel_fichier3 2022 03 14

Auriez-vous le bon code ?

Un grand merci par avance :)
Je continue à tâtonner .. et je joins un petit fichier test qui contient le code de la recherche.
Amicalement,
lionel :)
 

Pièces jointes

  • Recherche_classeurs.xlsm
    33.5 KB · Affichages: 23
Dernière édition:
Solution
job75
Bonjour Lionel, le forum,

Je disais que ce fil était sans fin !!!

Pour traiter plusieurs feuilles il suffit d'ajouter une boucle sur les noms des feuilles :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille, plage As Range, lig&, i%, col As Range, x$, n&
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = Array("Appels", "Sextant", "Dr House") 'liste des feuilles où l'on recherche
Set plage = [D1:G10000] 'référence de la plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""...
Trier par date Trier par votes
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
ChTi160 à dit:
Bonjour le Fil
@Gérard
Effectivement ! Mais ce n'était qu'un exemple adaptable facilement à la Procédure du #80
Voir ci-dessous :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, col$, lig&, x$, i As Variant
cible = [B1] 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
col = "C6" 'colonne F en notation R1C1
lig = 2
 With ActiveSheet.Hyperlinks
                 .Delete
    While fichier <> ""
        x = chemin & "[" & fichier & "]" & feuille & "'!" & col & ",0)"
        i = ExecuteExcel4Macro("MATCH(" & cible & ",'" & x) 'recherche un nombre
        If IsError(i) Then i = ExecuteExcel4Macro("MATCH(""" & cible & """,'" & x) 'recherche un texte
        If IsNumeric(i) Then
                 .Add Anchor:=Cells(lig, 4), Address:=fichier, SubAddress:="Appels!F" & i, _
                                                  ScreenTip:=fichier, TextToDisplay:=fichier ' On ajoute le Lien Hypertext vers la cellule du Fichier concerné
            Cells(lig, 5) = feuille 'le Nom de la feuille Source
            Cells(lig, 6) = "F" & i 'l'adresse de la cellule source
            lig = lig + 1 'On incrémente la Ligne
        End If
        fichier = Dir 'fichier suivant
    Wend
End With
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
End Sub
Ainsi la Procédure :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
n'a plus lieu d'être!
Bonne Journée
Jean marie
Cliquez pour agrandir...
Re-Phil,
En fait, si le fichier est ouvert, ton code fonctionne nickel :)
Ce qui serait bien, ce serait qu'au clic sur le lien, à l'arrivée sur le fichier, ce code puisse s'exécuter :
VB: 
Application.EnableEvents = False
ActiveWindow.ScrollRow = Selection.Row
ActiveCell.RowHeight = 55
ActiveCell.Offset(0, -5).Select
Application.EnableEvents = True
@+,
lionel :)
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Ah ! y fonctionne pas fichiers fermés ?
Gardes donc la version de Gérard qui fonctionne avec le Double_Click ce sera plus simple puisque ça fonctionne déjà ! Lol
Pourquoi faire compliqué quand on peut faire simple lol
Bonne journée
Jean marie
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Usine à gaz à dit:
Est-il possible que la recherche se fasse non pas sur 33+les 9 chiffres mais sur les 9 derniers chiffres ?
Cliquez pour agrandir...
J'ai eu du mal mais j'ai trouvé, et effectivement une 4ème colonne est bien utile, fichier (5) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, plage$, lig&, x$
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
plage = "F1:F10000" 'plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""
    x = chemin & "[" & fichier & "]" & feuille & "'!" & plage
    Cells(lig, 6).FormulaArray = "=MATCH(""*" & cible & """,""""&'" & x & ",0)" 'formule matricielle
    If IsNumeric(CStr(Cells(lig, 6))) Then
        Cells(lig, 4) = fichier
        Cells(lig, 5) = feuille
        Cells(lig, 7) = "=INDEX('" & x & "," & Cells(lig, 6) & ")"
        Cells(lig, 7) = Cells(lig, 7).Value 'supprime la formule
        Cells(lig, 7).NumberFormat = "General"
        Cells(lig, 6) = "F" & Cells(lig, 6) 'supprime la formule
        lig = lig + 1
    End If
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
Application.EnableEvents = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, wb As Workbook, lig&
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
If wb Is Nothing Then
    Set wb = Workbooks.Open(chemin & Cells(lig, 4))
    Application.EnableEvents = False
    Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6)).Offset(, -5), True 'cadrage
    If Not wb Is Nothing Then ActiveCell.RowHeight = 55
    Application.EnableEvents = True
End If
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub
C'est toujours la 1ère occurrence de chaque feuille qui est récupérée.

Tu remarqueras que j'ai simplifié ton code sur la 2ème macro.
 

Pièces jointes

  • Recherche(5).xlsm
    23.8 KB · Affichages: 4
  • isiTel_lionel_ExpRealty 2022 03 20.xlsb
    9.3 KB · Affichages: 1
  • isiTel_lionel_Global 2022 03 20.xlsb
    9.3 KB · Affichages: 1
  • isiTel_lionel_Mael 2022 03 20.xlsb
    9.3 KB · Affichages: 1
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Ça n'a pas beaucoup d'importance , mais je propose de modifier cette Ligne pour y inclure la Colonne "G"
VB: 
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
en
Range("D" & lig & ":G" & Rows.Count).ClearContents 'RAZ
bien vue je n'avais pas fait attention à cette demande !
Usine à gaz à dit:
Est-il possible que la recherche se fasse non pas sur 33+les 9 chiffres mais sur les 9 derniers chiffres ?
Cliquez pour agrandir...

Bonne fin de Journée
Jean marie
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Re-
job75 à dit:
J'ai eu du mal mais j'ai trouvé, et effectivement une 4ème colonne est bien utile, fichier (5) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, plage$, lig&, x$
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
plage = "F1:F10000" 'plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""
    x = chemin & "[" & fichier & "]" & feuille & "'!" & plage
    Cells(lig, 6).FormulaArray = "=MATCH(""*" & cible & """,""""&'" & x & ",0)" 'formule matricielle
    If IsNumeric(CStr(Cells(lig, 6))) Then
        Cells(lig, 4) = fichier
        Cells(lig, 5) = feuille
        Cells(lig, 7) = "=INDEX('" & x & "," & Cells(lig, 6) & ")"
        Cells(lig, 7) = Cells(lig, 7).Value 'supprime la formule
        Cells(lig, 7).NumberFormat = "General"
        Cells(lig, 6) = "F" & Cells(lig, 6) 'supprime la formule
        lig = lig + 1
    End If
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
Application.EnableEvents = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, wb As Workbook, lig&
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
If wb Is Nothing Then
    Set wb = Workbooks.Open(chemin & Cells(lig, 4))
    Application.EnableEvents = False
    Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6)).Offset(, -5), True 'cadrage
    If Not wb Is Nothing Then ActiveCell.RowHeight = 55
    Application.EnableEvents = True
End If
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub
C'est toujours la 1ère occurrence de chaque feuille qui est récupérée.

Tu remarqueras que j'ai simplifié ton code sur la 2ème macro.
Cliquez pour agrandir...
He Gérard, MERCI, je suis toujours en train de plancher sur mes 2 derniers soucis.
Je vais tester et je reviens te dire :)
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Jean-Marie :)
Je viens de résoudre le problème de ton code an ajoutant ce code :

VB: 
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Application.EnableEvents = False
ActiveCell.Offset(0, 8) = ""
ActiveCell.RowHeight = 55
ActiveCell.Offset(0, -5).Select
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub
Ton code va bien maintenant :)
Il me reste mes 2 soucis du #post103 mais Gérard vient de m'envoyer une nouvelle version que je vais tester :)
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Usine à gaz à dit:
Re-

He Gérard, MERCI, je suis toujours en train de plancher sur mes 2 derniers soucis.
Je vais tester et je reviens te dire :)
Cliquez pour agrandir...
Re-Gérard, re-super et Merci encore le point 2 est résolu :)

Il ne reste plus que celui-là :
1 - J'avais réservé 4 colonnes (D-E-F-G) ou je pourrais mettre les numéros de téléphone.
A 99 % j'ai un seul numéro de téléphone par Prospect qui toujours est mis en col F
Exceptionnellement il peut arriver que j'ai plusieurs numéros de téléphone pour un Prospect
Est-il possible de rechercher dans les colonnes D-E-F-G ?

Je continue à chercher de mon côté ...
je suis en train de regarder comment fonctionnent les applications MATCH.
Je suis actuellement sur cette vidéo :
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Usine à gaz à dit:
Est-il possible de rechercher dans les colonnes D-E-F-G ?
Cliquez pour agrandir...
Oui Lionel, mais MATCH (EQUIV) ne recherche que dans une seule colonne.

Pour rechercher dans plusieurs colonnes il suffit de faire une boucle, fichier (6) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, plage As Range, lig&, col As Range, x$
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
Set plage = [D1:G10000] 'référence de la plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""
    For Each col In plage.Columns
        x = chemin & "[" & fichier & "]" & feuille & "'!" & col.Address
        Cells(lig, 6).FormulaArray = "=MATCH(""*" & cible & """,""""&'" & x & ",0)" 'formule matricielle
        If IsNumeric(CStr(Cells(lig, 6))) Then
            Cells(lig, 4) = fichier
            Cells(lig, 5) = feuille
            Cells(lig, 7) = "=INDEX('" & x & "," & Cells(lig, 6) & ")"
            Cells(lig, 7) = Cells(lig, 7).Value 'supprime la formule
            Cells(lig, 7).NumberFormat = "General" 'format Standard
            Cells(lig, 6) = Split(col.Address, "$")(1) & Cells(lig, 6) 'adresse qui écrase la formule
            lig = lig + 1
    End If
    Next col
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":G" & Rows.Count).ClearContents 'RAZ
Application.EnableEvents = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, lig&, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
If wb Is Nothing Then
    Set wb = Workbooks.Open(chemin & Cells(lig, 4))
    Application.EnableEvents = False
    With wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
        Application.Goto .Cells(1, 2 - .Column), True 'cadrage
        .RowHeight = 55
    End With
    Application.EnableEvents = True
End If
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub
La 1ère occurrence de chaque colonne est récupérée.
 

Pièces jointes

  • Recherche(6).xlsm
    24.8 KB · Affichages: 1
  • isiTel_lionel_ExpRealty 2022 03 20.xlsb
    9.4 KB · Affichages: 1
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
Microsoft 365 recherche multicritère de la valeur suivante
2
Réponses
29
Affichages
755
alexga78
A
Usine à gaz
  • Résolu(e)
XL 2021 Rechercher dans plusieurs fichiers
2
Réponses
18
Affichages
1 K
Usine à gaz
Usine à gaz
A
  • Question
XL 2019 rechercher un nom dans plusieurs fichiers
Réponses
4
Affichages
418
sylvanu
sylvanu
jeanmi
  • Résolu(e)
XL 2013 recherche de données sur plusieurs fichiers
Réponses
13
Affichages
370
dysorthographie
dysorthographie
M
  • Question
Microsoft 365 Pb de formules qui se modifient dans des cellules verrouillées
Réponses
14
Affichages
521
TooFatBoy
TooFatBoy
ArnaudSi
  • Question
XL pour MAC Besoin d'aide pour calculer automatiquement un jour de livraison dans Excel
Réponses
10
Affichages
859
ArnaudSi
ArnaudSi
L
  • Question
Microsoft 365 Effectué une recherche dans plusieurs fichiers
2 3
Réponses
42
Affichages
3 K
job75
job75
M
  • Question
Microsoft 365 Indice de révision de chaque ligne automatiquement
Réponses
2
Affichages
142
MLIZIN
M
vgendron
  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
940
Staple1600
Staple1600
S
  • Résolu(e)
XL 2019 fichier suivi de chantier
Réponses
8
Affichages
1 K
saimone
S

Membres actuellement en ligne

5 membres et 94 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 333
Membres
111 104
dernier inscrit
JEMADA