Sub Travaux()
Const MotClef = "modifications parcours branchement"
Dim der&, ta, tg, th, s, ns&, i&, k&, debut
debut = Timer: Application.ScreenUpdating = False
With Sheets("Feuil1")
If .FilterMode Then .ShowAllData
.Columns("h:h").ClearContents
der = .Cells(Rows.Count, "a").End(xlUp).Row
ta = .Range("a1:a" & der): tg = .Range("g1:g" & der): th = .Range("h1:h" & der)
s = Split(MotClef): ns = UBound(s)
For i = 1 To UBound(ta)
If ta(i, 1) <> "" Then
For k = 0 To ns
If InStr(1, tg(i, 1), s(k), vbTextCompare) > 0 Then th(i, 1) = "travaux": Exit For
Next k
End If
Next i
.Range("h1").Resize(UBound(th)) = th
End With
MsgBox "Pour " & Format(der, "#,##0") & " lignes, durée = " & Format(Timer - debut, "#,##0.00\ sec.")
End Sub