XL 2016 Afficher les lignes de tableaux correspondant à un label

[monakiel]

Bonjour,
Voilà : je cherche un moyen d'afficher le ou les résultats d'une recherche effectuée dans 2 tableaux :
- un tableau contenant la définition de fonctionnalités quelconques
- un autre contenant les technologies utilisées par ses fonctionnalités
La première idée qui m'est passé est de donner une référence commune aux lignes concernées de chaque tableau pour pouvoir les retrouver mais je ne sais pas comment faire...
Je joins un exemple de ce que je souhaite utiliser/voir si ça peut aider.

Le but, pour être plus explicit, est double :
- soit je recherche une fonctionnalité et dans ce cas, ça m'affiche les technologies qui y sont liées
- soit je recherche une technologie et ça m'affiche les fonctionnalités
A noter qu'une technologie ou une fonctionnalité peut être liée à une autre et pour couvrir ce cas la recherche doit s'effectuer dans chacun des tableaux...

J'espère que ma question est compréhensible...
Cordialement

 

[Robert]

Bonjour Monakiel, bonjour le forum,

En pièce jointe ton fichier avec la macro événementielle Change ci-dessous. Tapes le texte recherché en B1 de l'onglet Recherche. Les lignes contenant le mots s'affichent à partir de A3.
Le code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer  'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

If Target.Address <> "$B$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en B1, sort de la procédure
Me.Range("A3").CurrentRegion.ClearContents 'éfface d'éventuelles anciennes données
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 O In Sheets 'boucle 1 sur tous les onglets du classeur
  If O.Name <> Me.Name Then 'condition 1 : si le nom de l'onglet n'est pas le nom de cet onglet (="Recherche")
  DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
  TV = O.Range("A1:C" & DL) 'définit le tableau des valeurs TV
  For I = 3 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la troisième)
  For J = 1 To 3 'boucle 3 sur toutes les colonne J tu tableau des valeurs
  'condition 2 : si le nom édité dans la cellue B1 est contenu dans la donnée ligne I colonne J de TV
  If InStr(1, TV(I, J), Target.Value, vbTextCompare) <> 0 Then
  ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
  For L = 1 To 3 'boucle 4 : sur toutes les colonne du tableau des valeurs TV
  TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV  (= Transposition)
  Next L 'prochaine colonne de la boucle 4
  TL(4, K) = O.Name 'récupère dans la ligen 4 de TL le nom de l'onglet de la boucle 1
  K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
  Exit For 'sort de la boucle 3
  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 TV 'vide le tableau Tv
Next O 'prochain onglet de la boucle 1
If K > 1 Then 'condition : si K est supérierure à 1
  'renvoie dans A3 redimensionnée de cet onglet (="Recherche") le tableau TL transposé
  Me.Range("A3").Resize(UBound(TL, 2), UBound(TL, 1)) = Application.Transpose(TL)
Else 'sinon
  MsgBox "Aucune occurrence trouvée de [" & Target.Value & "] !" 'message
End If 'fin de la condition
End Sub

Le fichier :

 

[monakiel]

Bonjour Robert,
Juste... Wow ?
Merci pour le GRAND coup de main