Option Explicit
Const Tâches = "B8:D12,B21:D25" 'Plage des Tâches
Const Absences = "F8:H12,F21:H25" 'Plage des Absences
Const Dates = 1 'N° de colonne des dates.
Private Sub Worksheet_Change(ByVal Cible As Range)
Dim i&, j&, tf1 As Boolean, tf2 As Boolean, tmp, ch$, x
Dim oCel As Range, lCel As Range, lPlg As Range, Plg As Range
Dim oDic As New Scripting.Dictionary 'Nécessite le référencement de la bibliothèque Microsoft Scripting Runtime
Set Plg = Intersect(Cible, Union(Range(Absences), Range(Tâches)))
If Not Plg Is Nothing Then
With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
For Each lCel In Intersect(Plg.Cells, Union(Range(Absences), Range(Tâches))).Rows
tmp = Intersect(Rows(lCel.Row), Range(Absences)).Value
oDic.RemoveAll
For i = 1 To UBound(tmp, 2)
x = Split(tmp(1, i), "+")
For j = 0 To UBound(x): oDic(Trim(x(j))) = Trim(x(j)): Next
Next
Set lPlg = Intersect(Rows(lCel.Row), Range(Tâches))
tmp = oDic.Keys
tf1 = False
For Each oCel In lPlg.Cells
tf2 = False
oCel.Font.Bold = False
ch = "+" & Trim(oCel.Value) & "+"
For i = 0 To oDic.Count - 1
If ch Like "*+" & oDic(tmp(i)) & "+*" Then
tf2 = True
oCel.Characters(Start:=InStr(oCel.Value, oDic(tmp(i))), Length:=Len(oDic(tmp(i)))).Font.FontStyle = "Gras"
End If
Next
tf1 = tf1 Or tf2
If tf2 Then oCel.Interior.ColorIndex = 45 Else oCel.Interior.ColorIndex = xlNone
Next
If tf1 Then Cells(lPlg.Row, Dates).Interior.ColorIndex = 3 Else Cells(lPlg.Row, Dates).Interior.ColorIndex = xlNone
Next
With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End If
End Sub