Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, tabP, Q As Range, tabQ, datmin&, datmax&, d As Object, i&, deb&, fin&, dat
Set P = [A1].CurrentRegion.Resize(, 2): tabP = P.Value2 'matrice, plus rapide
Set Q = [E1].CurrentRegion.Resize(, 2): tabQ = Q.Value2 'matrice, plus rapide
datmin = Application.Min(Q.Columns(1))
datmax = Application.Max(Q.Columns(1))
'---mémorise les dates du tableau P---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tabP)
deb = Val(tabP(i, 1))
If deb > 0 Then
deb = IIf(deb > datmin, deb, datmin)
fin = Val(tabP(i, 2))
If fin = 0 Then fin = Date
fin = IIf(fin < datmax, fin, datmax)
For dat = deb To fin
d(dat) = "absent"
Next dat
End If
Next i
'---remplissage du tableau Q---
For i = 2 To UBound(tabQ)
tabQ(i, 2) = d(tabQ(i, 1))
Next i
'---restitution---
Application.EnableEvents = False 'désactive les évènements
Q = tabQ
Application.EnableEvents = True 'réactive les évènements
End Sub