Dim t# 'mémorise la variable
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim periode#, cherche$, c As Range, P As Range
periode = 1 'en secondes, à adapter
Arret
Cells.FormatConditions.Delete 'supprime la MFC
cherche = "*" & LCase(CStr([B1])) & "*"
If cherche = "**" Then Exit Sub
For Each c In UsedRange
If LCase(CStr(c)) Like cherche Then Set P = Union(IIf(P Is Nothing, c, P), c)
Next
If P Is Nothing Then Exit Sub
P.FormatConditions.Add xlExpression, Formula1:="=Couleur" 'crée la MFC
P.FormatConditions(1).Interior.Color = 0 'fond noir
P.FormatConditions(1).Font.Color = 15921906 'police blanche
P.FormatConditions(1).Font.Bold = True 'gras
t = Timer
Do
ThisWorkbook.Names.Add "Couleur", True 'nom défini
If t = 100000 Then Exit Do 'arrêt
t = Timer
While t + periode < 86400 And Timer < t + periode / 2: DoEvents: Wend
ThisWorkbook.Names.Add "Couleur", False 'nom défini
While t + periode < 86400 And Timer < t + periode: DoEvents: Wend
Loop
End Sub
Sub Arret()
t = 100000
End Sub
Sub Effacer()
t = 100000
[B1] = ""
Cells.FormatConditions.Delete 'supprime la MFC
End Sub