Salut Mattcoach,
Salut Boss,
une version VBA qui fait le compte au moindre changement de valeur dans le tableau en affichant les résultats en colonne [Z:Z].
La ligne 1 reçoit les mots à rechercher, mots que tu peux inscrire, ajouter, effacer dans n'importe quelle cellule de la ligne, la macro les regroupant à droite.
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tTab, tData, tItem, iRow%, iCol%
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
Range("Z2:Z" & Range("Z" & Rows.Count).End(xlUp).Row + 1).Clear
If Not Intersect(Target, Range("A1:Y" & iRow)) Is Nothing Then
For x = 1 To 25
iCol = Range("A1:AA1").Find(what:="", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Column
If Cells(1, x) <> "" And iCol > x Then Range(Chr(64 + x) & 1).Cut Destination:=Range(Chr(64 + iCol) & 1)
Next
Range("A1:Z1").Interior.Color = RGB(255, 190, 0)
tTab = Range("A1:Y" & iRow).Value
tData = Range("Z1:Z" & iRow).Value
If WorksheetFunction.CountA(Range("A1:Z1")) > 0 Then
tItem = Range(Chr(64 + iCol + IIf(Cells(1, iCol) = "", 1, 0)) & "1:AA1").Value
For x = 2 To UBound(tTab, 1)
For Z = 1 To UBound(tItem, 2) - 1
For y = 1 To UBound(tTab, 2)
If InStr(LCase(tTab(x, y)), LCase(tItem(1, Z))) > 0 Then tData(x, 1) = tData(x, 1) + 1
Next
Next
Next
Range("Z1:Z" & iRow).Value = tData
Range("Z2:Z" & iRow).Interior.Color = RGB(215, 215, 215)
End If
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
A+