Private Sub Worksheet_Change(ByVal Target As Range)
Dim code As Range, ville As Range, t, xcode$, d As Object, i&, xville$, n&, a()
Set code = [H2]: Set ville = [J2] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
ville(2).Resize(Rows.Count - ville.Row, 3).Delete xlUp 'RAZ
t = [A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
xcode = code & "*"
'---liste de validation des villes---
Set d = CreateObject("Scripting.Dictionary")
If code <> "" Then
For i = 2 To UBound(t)
If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" Then d(t(i, 5)) = ""
Next
End If
ville.Validation.Delete
With [Z:Z] 'colonne auxiliaire
.ClearContents
If d.Count Then
With .Resize(d.Count)
.Value = Application.Transpose(d.keys)
.Sort .Cells(1), xlAscending, Header:=xlNo 'tri alphabétique
ville.Validation.Add xlValidateList, Formula1:="=" & .Address
End With
End If
End With
'---tableau des résultats---
If code = "" Or Application.CountIf([Z:Z], ville) = 0 Then ville = ""
xville = ville
If xville <> "" Then
For i = 2 To UBound(t)
If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" And t(i, 5) = xville Then
n = n + 1
ReDim Preserve a(1 To 3, 1 To n)
a(1, n) = t(i, 1)
a(2, n) = t(i, 3)
a(3, n) = t(i, 2)
End If
Next
End If
If n Then
With ville(2).Resize(n, 3)
.Value = Application.Transpose(a)
.Borders.Weight = xlThin
End With
End If
Application.EnableEvents = True 'réactive les évènements
End Sub