Salut Jean Talus,
Salut la fine équipe,
et une autre pour la route...
En [A:A], tu adaptes la liste des mots à rechercher.
Un double-clic sur la feuille démarre la macro.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iIdx%
'
Cancel = True
Columns("D:E").Delete shift:=xlToLeft
iRow = Range("A" & Rows.Count).End(xlUp).Row
tTab = Range("A1:E" & Range("B" & Rows.Count).End(xlUp).Row).Value
'
tTab(1, 4) = "Résultats"
For x = 2 To UBound(tTab, 1)
iIdx = 0
For y = 1 To iRow
If InStr(tTab(x, 2), tTab(y, 1)) > 0 Then
If iIdx > 0 Then _
If Len(tTab(y, 1)) > Len(tTab(iIdx, 1)) Then iIdx = y
If iIdx = 0 Then iIdx = y
End If
If iIdx > 0 Then
tTab(x, 5) = tTab(iIdx, 1)
tTab(x, 4) = RTrim(Replace(CStr(tTab(x, 2)), CStr(tTab(iIdx, 1)), ""))
If Right(tTab(x, 4), 2) = "()" Then tTab(x, 4) = RTrim(Split(tTab(x, 4), "()")(0))
End If
Next
Next
Range("A1").Resize(UBound(tTab, 1), 5).Value = tTab
Columns.AutoFit
'
End Sub
A+