Sub Liste3Crit()
Dim debut, fin, derlig, tablo, dico, i&, key
debut = Range("a1"): fin = Range("a2")
Range("h2:h" & Rows.Count).ClearContents
derlig = Cells(Rows.Count, "d").End(xlUp).Row
tablo = Range("c2:e" & derlig)
Set dico = CreateObject("scripting.dictionary")
dico.comparemode = vbTextCompare
For i = 1 To UBound(tablo)
If tablo(i, 1) >= debut And tablo(i, 1) <= fin And tablo(i, 3) <> 0 Then
dico(tablo(i, 2)) = ""
End If
Next i
If dico.Count > 0 Then
ReDim res(1 To dico.Count, 1 To 1): i = 0
For Each key In dico.keys
i = i + 1: res(i, 1) = key
Next key
Range("h2").Resize(dico.Count) = res
Range("h1").Resize(dico.Count + 1).Sort Range("h1"), xlAscending, Header:=xlYes
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldsel
If Not Intersect(Target, Union(Range("a1:a2"), Range("c:e"))) Is Nothing Then
Application.EnableEvents = False
Set oldsel = Selection
Liste3Crit
Application.EnableEvents = True
oldsel.Select
End If
End Sub