Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz · 14 Mars 2022

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) ? :

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

job75 · 14 Août 2022

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 <> ""...

Usine à gaz · 20 Mars 2022

Bjr Gérard,
Merci_ pour ce retour ... mais ça m'arrange pas du tout lol
Je continue mes recherches,
lionel

Usine à gaz · 20 Mars 2022

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

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

ChTi160 · 20 Mars 2022

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

job75 · 20 Mars 2022

Usine à gaz à dit:
Est-il possible que la recherche se fasse non pas sur 33+les 9 chiffres mais sur les 9 derniers chiffres ?

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.

ChTi160 · 20 Mars 2022

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 ?

Bonne fin de Journée
Jean marie

Usine à gaz · 20 Mars 2022

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.

He Gérard, MERCI, je suis toujours en train de plancher sur mes 2 derniers soucis.
Je vais tester et je reviens te dire

Usine à gaz · 20 Mars 2022

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

ChTi160 · 20 Mars 2022

Re
Je viens en testant de me rendre compte que la recherche #109
Peut donc se faire avec de 1 à x chiffres
Enfin chez moi

Bonne Journée
Jean marie

Usine à gaz · 20 Mars 2022

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

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 :

Usine à gaz · 20 Mars 2022

Voici ce qui se passe :

J'ai bien des "111111111" dans les fichiers

job75 · 20 Mars 2022

Usine à gaz à dit:
Est-il possible de rechercher dans les colonnes D-E-F-G ?

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.

Usine à gaz · 20 Mars 2022

Merci Gérard, je vais regarder

Usine à gaz · 20 Mars 2022

Re-Gérard

Nickel c'est tout bon cette fois-ci.
Un p'tit peu moins rapide mais très acceptable.

Encore merci pour ta patience
lionel

job75 · 21 Mars 2022

Bonjour Lionel, le forum,

Je viens de modifier mon post #116 à ce niveau :

VB:

Cells(lig, 6) = Split(col.Address, "$")(1) & Cells(lig, 6) 'adresse qui écrase la formule

A+

Usine à gaz · 21 Mars 2022

Bonjour Gérard, le Forum,
Merci pour cette modification.
Aujourd'hui travail test en réel toute la journée.
Je te dis ce soir,
Merci Gérard

Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires