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

job75 · 19 Mars 2022

Lionel, nous balancer :

VB:

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

alors qu'on ne fait que sélectionner est insupportable !!!.

Si tu veux éviter les usines à gaz tâche de modérer tes ardeurs !!!

@ChTi160 :un message est nécessaire mais seulement quand c'est nécessaire !!!

Usine à gaz · 19 Mars 2022

ChTi160 à dit:
Re
Lionel !
Une question n'y a-t-il pas un problème de traiter l'absence de Fichier soit :

VB:

If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" &

Après avoir traité les données .

Code:

On Error Resume Next Set wb = Workbooks(CStr(Cells(lig, 4))) Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))

tu me diras le :

Code:

On Error Resume Next

fait le Boulot Lol
et alors le

Code:

If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '"

n'a plus lieu d'être
Ou alors une fois encore j'ai pas compris ! Lol
Bonne journée
Jean marie

Dsl Jean-Marie mon niveau ne me permet pas d'être capable de te répondre

Usine à gaz · 19 Mars 2022

job75 à dit:
Lionel, nous balancer :

VB:

Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual

alors qu'on ne fait que sélectionner est insupportable !!!.

Si tu veux éviter les usines à gaz tâche de modérer tes ardeurs !!!

@ChTi160 :un message est nécessaire mais seulement quand c'est nécessaire !!!

OUI Gérard, je comprends ce que tu dis.
Mais dans mes fichiers des codes s'exécutent à la sélection de cellules "Private Sub Worksheet_SelectionChange(ByVal R As Range)" et je dois les neutraliser avant la sélection et les remettre après pour continuer mon "boulot".
Comment faire autrement ?
lionel

ChTi160 · 19 Mars 2022

Bonsoir ,
Gérard
Y'a pas que Lionel que je ne comprends pas lol
tu dis :

un message est nécessaire mais seulement quand c'est nécessaire !!!

Quel message ?
Bonne fin de soirée
Jean marie

job75 · 19 Mars 2022

Usine à gaz à dit:
OUI Gérard, je comprends ce que tu dis.
Mais dans mes fichiers des codes s'exécutent à la sélection de cellules "Private Sub Worksheet_SelectionChange(ByVal R As Range)" et je dois les neutraliser avant la sélection et les remettre après pour continuer mon "boulot".

D'accord, s'il y a des macros SelectionChange il faut les Application.EnableEvents.

Mais les Application.ScreenUpdating et Application.Calculation sont inutiles.

ChTi160 à dit:
Quel message ?

Eh bien celui qui est au bout de cette ligne :

VB:

If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48

ChTi160 · 19 Mars 2022

Re
Gérard
Effectivement mon petit niveau (mais je progresse) a fait que je voyais plus cette Ecriture ( que celle de Lionel!)

VB:

On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" & Cells(lig, 4) & "' !", 48
Etc Etc

d'où mon erreur !
Et cette gestion (d'erreur) n'aura d'effet que si le fichier source est traité fermé ! ou la fermeture accidentelle du Fichier Source .
Mais bon je note votre remarque !
Merci encore de votre partage
Bonne fin de Soirée
Jean marie

ChTi160 · 19 Mars 2022

Re
J'avais évoqué la possibilité ou pas d'utiliser des Liens Hypertext !
Mais Bon !
J'ai à mon petit niveau réussi à ça ! Je me permets de mettre une petite vidéo (Les 3 Fichiers source sont fermés dans la Vidéo)
Bonne fin de Soirée
Jean marie

Usine à gaz · 19 Mars 2022

ChTi160 à dit:
Re
J'avais évoqué la possibilité ou pas d'utiliser des Liens Hypertext !
Mais Bon !
J'ai à mon petit niveau réussi à ça ! Je me permets de mettre une petite vidéo (Les 3 Fichiers source sont fermés dans la Vidéo)
Bonne fin de Soirée
Jean marie

Re-Phil "petit niveau" lol

ça a l'air pas mal .... on peut tester ?

Usine à gaz · 19 Mars 2022

ChTi160 à dit:

Re
ce que j'ai ajouté a la procédure de Gérard

VB:

lig = 2
  ActiveSheet.Hyperlinks.Delete
For Each fich In fichier
    If Dir(chemin & fich) = "" Then MsgBox "Fichier '" & fich & "' introuvable !", 48: GoTo 1
    x = chemin & "[" & fich & "]" & 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
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(lig, 4), Address:=fich, SubAddress:="Appels!F" & i, ScreenTip:=fich, TextToDisplay:=fich
        Cells(lig, 5) = feuille
        Cells(lig, 6) = "F" & i
        lig = lig + 1
    End If
Next

Jean marie

Dsl pas compris : tu me donnes le code complet ,

job75 · 19 Mars 2022

@ChTi160 dans la procédure du post #80 il n'y a plus de variable fich !

ChTi160 · 20 Mars 2022

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

Usine à gaz · 20 Mars 2022

Bonjour Jean-Marie, le Forum,

Merci pour ton travail et ton code fonctionne bien
Je continue mes tests.
Bon dimanche,
lionel

Usine à gaz · 20 Mars 2022

Re- Jean-Marie,

Après tests, ton code me pose un souci.
Il atteint bien le numéro de téléphone cherché mais j'ai un autre besoin :
- J'utilise des filtrages dans mes fichiers de travail,
- après avoir atteint le numéro, je dois pouvoir continuer mon travail et là ton code désactive les codes sans que je puisse les réactiver par "Application.EnableEvents = True"

Dans le code de Gérard (double clic, ) :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
'ActiveSheet.Unprotect Password:=""
Dim wb As Workbook, lig&
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
    ActiveWindow.ScrollRow = Selection.Row
    ActiveCell.RowHeight = 55
   ActiveCell.Offset(0, -5).Select
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" & Cells(lig, 4) & "' !", 48
'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
End Sub

ActiveWindow.ScrollRow = Selection.Row = me permet d'atteindre le numéro
ActiveCell.RowHeight = 55 = mettre la ligne à hauteur 55, si la ligne est filtrée (hauteur 0),
ActiveCell.Offset(0, -5).Select = sélection de la cellule A de la mettre ligne sans déclencher d'éxécution de code non souhaité,
et ensuite de pouvoir travailler sur la ligne pour le rappel.
lionel

Usine à gaz · 20 Mars 2022

Bonjour Gérard,
J'ai beaucoup testé cette nuit et j'ai fait le tour de tous les cas qui peuvent se présenter.
Ton code dernière version #post 80 fonctionne nickel :

VB:

Option Explicit

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
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
        Cells(lig, 4) = fichier
        Cells(lig, 5) = feuille
        Cells(lig, 6) = "F" & i
        lig = lig + 1
    End If
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
Dim wb As Workbook, lig&
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
    ActiveWindow.ScrollRow = Selection.Row
ActiveCell.RowHeight = 55
ActiveCell.Offset(0, -5).Select
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" & Cells(lig, 4) & "' !", 48
Application.EnableEvents = True
End Sub

Mais j'ai encore 2 soucis, pour 2 situations qui peuvent se produire, je n'y avais pas pensé, et je pense que ce sera complet cette fois-ci.

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 ?

2 - Tous mes numéros commencent par 33 et ensuite les 9 chiffres
Que le prospect habite en France métropolitaine ou en Outer mer, c'est toujours avec le 33 devant les 9 chiffres que je les appelle.
Quand un prospect me rappelle d'Outre mer, Il arrive de temps en temps (et je ne sais pas pourquoi) que l'indicatif téléphonique de son département s'affiche devant les 9 autres chiffres à la place du 33 par exemple 262111111111 etc…
Et puisque j'ai 33111111111 dans le fichier, la recherche ne trouve pas.
Est-il possible que la recherche se fasse non pas sur 33+les 9 chiffres mais sur les 9 derniers chiffres ?

Veux-tu encore m'aider et je pense que cette fois-ci, vu tous les tests que j'ai fait cette nuit, ce sera complet.
Je te souhaite ainsi qu'à tous un bon dimanche,
lionel

job75 · 20 Mars 2022

Bonjour Lionel, le forum,

Point 1 : il y a un seul numéro cherché, en B1, la colonne G n'a pas lieu d'être.

A+

Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires