XL 2016 macro - séparer résultat d'une recherche dans des tableaux

[monakiel]

Bonjour,
Précédemment sur le même thème j'ai reçu de l'aide pour avancer vers mon petit but, alors je reviens vers vous (@Robert )

Je cherche à séparer ma recherche en deux et à changer le rendu du tableau retourné. Je m'explique :

Actuellement je peux rechercher dans deux colonnes (référence, nom), la recherche d'une référence m'affiche toutes les fonctions et les technologies qui sont liées à la recherche.
Seulement la recherche d'un nom ne me retourne que l'entrée liée à ce nom.

Pour ce point j'aimerai que la recherche d'un nom me retourne toutes les lignes qui ont la référence du nom recherché (dans n'importe quel onglet)

La seconde chose, c'est que j'aimerai que le rendu soit séparé, dans mon fichier vous voyez que la recherche affiche seulement le nom de l'onglet dans lequel elle a trouvé l'information, le but est de séparer ce rendu en deux tableaux distincts

J'ai mis un exemple en dur pour que ce soit plus parlant...
J'espère que vous saurez m'aider, j'ai déjà mis du temps a comprendre le fonctionnement actuel c'est pour dire mon niveau =)

 

[Robert]

Bonjour Monakiel, bonjour le forum,

Essaie comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
'Cet évènement est déclanché lorsque le contenu d'une cellule est modifié dans la feuille
'le paramètre Target correspond à la cellule modifiée
Dim Onglet As Worksheet 'variable Onglet
Dim DL As Integer  'variable DL (Dernière Ligne du tableau parcouru)
Dim TdV As Variant 'variable TdV (Tableau des valeurs)
Dim I As Integer 'variable I (Compteur de lignes)
Dim J As Integer 'variable J (Compteur de colonnes)
Dim K As Integer 'variable K (On utilise K pour positionner l'écriture des lignes dans le tableau créé)
Dim L As Integer 'variable L (Compteur de colonne du nouveau tableau)
Dim TdC() As Variant 'variable TdC (Tableau des Colonnes)
Dim Ref As String 'déclare la variable Ref (REFérence)

If Target.Address <> "$B$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en B1, sort de la procédure
Me.Range("C3").CurrentRegion.ClearContents 'éfface d'éventuelles anciennes données
'"Me" fait référence à la feuille dans laquelle le code se trouve: Sheets("Recherche")
If Target.Value = "" Then Exit Sub 'si la cellule cible (B1) est effacée, sort de la procédure
K = 1 'initialise la variable K
For Each Onglet In Sheets 'boucle 1 sur tous les onglets du classeur
  If Onglet.Name <> Me.Name Then 'condition 1 : si le nom de l'onglet n'est pas le nom de cet onglet (="Recherche")
  DL = Onglet.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet en cours
  TdV = Onglet.Range("A1:D" & DL) 'définit la plage du le tableau des valeurs TdV
  For I = 3 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeur TdV (en partant de la troisième)
  For J = 1 To 2 'boucle 3 sur les colonnes J du tableau des valeurs (on recherche dans les deux premieres colonnes)
  'condition 2 : si le nom édité dans la cellue B1 est contenu dans la donnée ligne I colonne J de TdV
  If InStr(1, TdV(I, J), Target.Value, vbTextCompare) <> 0 Then
  If J = 1 Then 'condition : si l'occrence trouvée est un nom (en colonne 1)
  ReDim Preserve TdC(1 To 5, 1 To K) 'redimensionne le tableau des colonnes TdC (5 colonnes, K lignes)
  For L = 1 To 4 'boucle 4 : sur toutes les colonne du tableau des valeurs TdV
  TdC(L, K) = TdV(I, L) 'récupère dans la ligne L de TdC la donnée en colonne L de TdV  (= Transposition)
  Next L 'prochaine colonne de la boucle 4
  TdC(5, K) = Onglet.Name 'récupère dans la colonne 5 de TdC le nom de l'onglet de la boucle 1
  K = K + 1 'incrémente K (ajoute une ligne au tableau des lignes TdL)
  Exit For 'sort de la boucle 3
  Else 'sinon (si l'occurrence trouvée n'est pas un nom (en colonne 2)
  Ref = TdV(I, 1) 'définit la référence Ref
  GoTo fin 'va à l'étiquette "fin"
  End If 'fin de la condition
  End If 'fin de la condition 2
  Next J 'prochaine colonne de la boucle 3
  Next I 'prochaine ligne de la boucle 2
  End If 'fin de la condition 1
  Erase TdV 'vide le tableau Tv
Next Onglet 'prochain onglet de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
  'renvoie dans A3 redimensionnée de cet onglet (="Recherche") le tableau TL transposé
  Me.Range("C3").Resize(UBound(TdC, 2), UBound(TdC, 1)) = Application.Transpose(TdC)
Else 'sinon
  MsgBox "Aucune occurrence trouvée de [" & Target.Value & "] !" 'message
End If 'fin de la condition
Exit Sub 'sort de la procédure

fin: 'étiquette
K = 1 'initialise la variable K
For Each Onglet In Sheets 'boucle 1 sur tous les onglets du classeur
  If Onglet.Name <> Me.Name Then 'condition 1 : si le nom de l'onglet n'est pas le nom de cet onglet (="Recherche")
  DL = Onglet.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet en cours
  TdV = Onglet.Range("A1:D" & DL) 'définit la plage du le tableau des valeurs TdV
  For I = 3 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeur TdV (en partant de la troisième)
  For J = 1 To 2 'boucle 3 sur les colonnes J du tableau des valeurs (on recherche dans les deux premieres colonnes)
  'condition 2 : si le nom édité dans la cellue B1 est contenu dans la donnée ligne I colonne J de TdV
  'ou si la donnée ligne I, colonne 1 d TdV est égale à la variable Ref
  If InStr(1, TdV(I, J), Target.Value, vbTextCompare) <> 0 Or TdV(I, 1) = Ref Then
  ReDim Preserve TdC(1 To 5, 1 To K) 'redimensionne le tableau des colonnes TdC (5 colonnes, K lignes)
  For L = 1 To 4 'boucle 4 : sur toutes les colonne du tableau des valeurs TdV
  TdC(L, K) = TdV(I, L) 'récupère dans la ligne L de TdC la donnée en colonne L de TdV  (= Transposition)
  Next L 'prochaine colonne de la boucle 4
  TdC(5, K) = Onglet.Name 'récupère dans la colonne 5 de TdC le nom de l'onglet de la boucle 1
  K = K + 1 'incrémente K (ajoute une ligne au tableau des lignes TdL)
  Exit For 'sort de la boucle 3
  End If 'fin de la condition 2
  Next J 'prochaien colonne de la boucle 3
  Next I 'prochaine ligne de la boucle 2
  End If 'fin de la condition 1
Next Onglet 'prochain onglet de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
  'renvoie dans A3 redimensionnée de cet onglet (="Recherche") le tableau TL transposé
  Me.Range("C3").Resize(UBound(TdC, 2), UBound(TdC, 1)) = Application.Transpose(TdC)
Else 'sinon
  MsgBox "Aucune occurrence trouvée de [" & Target.Value & "] !" 'message
End If 'fin de la condition
End Sub

 

[monakiel]

Bonjour Monakiel, bonjour le forum,

Essaie comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
'Cet évènement est déclanché lorsque le contenu d'une cellule est modifié dans la feuille
'le paramètre Target correspond à la cellule modifiée
Dim Onglet As Worksheet 'variable Onglet
Dim DL As Integer  'variable DL (Dernière Ligne du tableau parcouru)
Dim TdV As Variant 'variable TdV (Tableau des valeurs)
Dim I As Integer 'variable I (Compteur de lignes)
Dim J As Integer 'variable J (Compteur de colonnes)
Dim K As Integer 'variable K (On utilise K pour positionner l'écriture des lignes dans le tableau créé)
Dim L As Integer 'variable L (Compteur de colonne du nouveau tableau)
Dim TdC() As Variant 'variable TdC (Tableau des Colonnes)
Dim Ref As String 'déclare la variable Ref (REFérence)

If Target.Address <> "$B$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en B1, sort de la procédure
Me.Range("C3").CurrentRegion.ClearContents 'éfface d'éventuelles anciennes données
'"Me" fait référence à la feuille dans laquelle le code se trouve: Sheets("Recherche")
If Target.Value = "" Then Exit Sub 'si la cellule cible (B1) est effacée, sort de la procédure
K = 1 'initialise la variable K
For Each Onglet In Sheets 'boucle 1 sur tous les onglets du classeur
  If Onglet.Name <> Me.Name Then 'condition 1 : si le nom de l'onglet n'est pas le nom de cet onglet (="Recherche")
  DL = Onglet.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet en cours
  TdV = Onglet.Range("A1:D" & DL) 'définit la plage du le tableau des valeurs TdV
  For I = 3 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeur TdV (en partant de la troisième)
  For J = 1 To 2 'boucle 3 sur les colonnes J du tableau des valeurs (on recherche dans les deux premieres colonnes)
  'condition 2 : si le nom édité dans la cellue B1 est contenu dans la donnée ligne I colonne J de TdV
  If InStr(1, TdV(I, J), Target.Value, vbTextCompare) <> 0 Then
  If J = 1 Then 'condition : si l'occrence trouvée est un nom (en colonne 1)
  ReDim Preserve TdC(1 To 5, 1 To K) 'redimensionne le tableau des colonnes TdC (5 colonnes, K lignes)
  For L = 1 To 4 'boucle 4 : sur toutes les colonne du tableau des valeurs TdV
  TdC(L, K) = TdV(I, L) 'récupère dans la ligne L de TdC la donnée en colonne L de TdV  (= Transposition)
  Next L 'prochaine colonne de la boucle 4
  TdC(5, K) = Onglet.Name 'récupère dans la colonne 5 de TdC le nom de l'onglet de la boucle 1
  K = K + 1 'incrémente K (ajoute une ligne au tableau des lignes TdL)
  Exit For 'sort de la boucle 3
  Else 'sinon (si l'occurrence trouvée n'est pas un nom (en colonne 2)
  Ref = TdV(I, 1) 'définit la référence Ref
  GoTo fin 'va à l'étiquette "fin"
  End If 'fin de la condition
  End If 'fin de la condition 2
  Next J 'prochaine colonne de la boucle 3
  Next I 'prochaine ligne de la boucle 2
  End If 'fin de la condition 1
  Erase TdV 'vide le tableau Tv
Next Onglet 'prochain onglet de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
  'renvoie dans A3 redimensionnée de cet onglet (="Recherche") le tableau TL transposé
  Me.Range("C3").Resize(UBound(TdC, 2), UBound(TdC, 1)) = Application.Transpose(TdC)
Else 'sinon
  MsgBox "Aucune occurrence trouvée de [" & Target.Value & "] !" 'message
End If 'fin de la condition
Exit Sub 'sort de la procédure

fin: 'étiquette
K = 1 'initialise la variable K
For Each Onglet In Sheets 'boucle 1 sur tous les onglets du classeur
  If Onglet.Name <> Me.Name Then 'condition 1 : si le nom de l'onglet n'est pas le nom de cet onglet (="Recherche")
  DL = Onglet.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet en cours
  TdV = Onglet.Range("A1:D" & DL) 'définit la plage du le tableau des valeurs TdV
  For I = 3 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeur TdV (en partant de la troisième)
  For J = 1 To 2 'boucle 3 sur les colonnes J du tableau des valeurs (on recherche dans les deux premieres colonnes)
  'condition 2 : si le nom édité dans la cellue B1 est contenu dans la donnée ligne I colonne J de TdV
  'ou si la donnée ligne I, colonne 1 d TdV est égale à la variable Ref
  If InStr(1, TdV(I, J), Target.Value, vbTextCompare) <> 0 Or TdV(I, 1) = Ref Then
  ReDim Preserve TdC(1 To 5, 1 To K) 'redimensionne le tableau des colonnes TdC (5 colonnes, K lignes)
  For L = 1 To 4 'boucle 4 : sur toutes les colonne du tableau des valeurs TdV
  TdC(L, K) = TdV(I, L) 'récupère dans la ligne L de TdC la donnée en colonne L de TdV  (= Transposition)
  Next L 'prochaine colonne de la boucle 4
  TdC(5, K) = Onglet.Name 'récupère dans la colonne 5 de TdC le nom de l'onglet de la boucle 1
  K = K + 1 'incrémente K (ajoute une ligne au tableau des lignes TdL)
  Exit For 'sort de la boucle 3
  End If 'fin de la condition 2
  Next J 'prochaien colonne de la boucle 3
  Next I 'prochaine ligne de la boucle 2
  End If 'fin de la condition 1
Next Onglet 'prochain onglet de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
  'renvoie dans A3 redimensionnée de cet onglet (="Recherche") le tableau TL transposé
  Me.Range("C3").Resize(UBound(TdC, 2), UBound(TdC, 1)) = Application.Transpose(TdC)
Else 'sinon
  MsgBox "Aucune occurrence trouvée de [" & Target.Value & "] !" 'message
End If 'fin de la condition
End Sub

Salut @Robert ,

c'est beau ce que tu fais...

Si je peux me permettre il me manque un dernier petit point : la mise en forme du tableau.
j'ajoute cela à ton code :

Me.ListObjects.Add(xlSrcRange, Range("C3").Resize(UBound(TdC, 2), (UBound(TdC, 1))), , xlNo).Name = "Résultat"

Pour avoir un tableau en sortie avec des entêtes, sais-tu comment je peux faire pour nommer les entêtes dans la macro ? (avec un nom fixe pour chacune)

Merci encore en tout cas...

 

[Robert]

Re,

Je déteste travailler avec des tableaux (ListObject) car les codes pour les manipuler sont trop compliqués pour moi... Je ne pourrait donc pas t'aider sur ce coup... Désolé.

 

[Dranreb]

Bonjour.
Le plus simple seraut sans doute d'affecter à [Résultat[#Headers]].Value = Array(…

Ou alors :

With Me.ListObjects.Add(xlSrcRange, Range("C3").Resize(UBound(TdC, 2), (UBound(TdC, 1))), , xlNo)
   .Name = "Résultat"
   .HeaderRowRange.Value = Array(…
   End With

 

[monakiel]

Bonjour.
Le plus simple seraut sans doute d'affecter à [Résultat[#Headers]].Value = Array(…

Ou alors :

With Me.ListObjects.Add(xlSrcRange, Range("C3").Resize(UBound(TdC, 2), (UBound(TdC, 1))), , xlNo)
   .Name = "Résultat"
   .HeaderRowRange.Value = Array(…
   End With

Bonjour,
Je n'ai pas bien compris l'instruction "with" mais la première idée fonctionne très bien !

 

[Dranreb]

Alors explication: comme l'exemplaire de l'objet créé est renvoyé par la méthode Add de la plupart des types d'objets représentant les entités Excel, on peut l'affecter par un Set à une variable de ce type ou le spécifier à une instruction With pour ensuite accéder à plusieurs de ses propriétés ou méthodes en les faisant précéder d'un point sans rien d'autre devant.