Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim T As Range, Auxiliaire As Range, P As Range
Set T = [Tableau189] 'tableau structuré
Set Auxiliaire = Range("K6")
Set Target = ActiveCell
If Intersect(Target, T.Resize(, 3)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
T.Validation.Delete 'RAZ
Auxiliaire.Resize(Rows.Count - Auxiliaire.Row + 1).Clear 'RAZ
With [BASE1] 'tableau structuré
.AutoFilter: .AutoFilter 'ôte le filtre
Set P = Auxiliaire.Resize(.Rows.Count)
Select Case Target.Column
Case T.Column
.Columns(1).Copy P(1)
Case T(1, 2).Column
If Target(1, 0) = "" Then Exit Sub
.AutoFilter 1, Target(1, 0)
.Columns(2).SpecialCells(xlCellTypeConstants).Copy P(1)
.AutoFilter
Case T(1, 3).Column
If Target(1, -1) = "" Or Target(1, 0) = "" Then Exit Sub
.AutoFilter 1, Target(1, -1)
.AutoFilter 2, Target(1, 0)
.Columns(3).SpecialCells(xlCellTypeConstants).Copy P(1)
.AutoFilter
End Select
End With
P.Sort P(1), xlAscending, Header:=xlNo 'tri
P.RemoveDuplicates 1, xlNo 'supprime les doublons
P.Resize(Application.CountA(P)).Name = "Liste" 'nomme la plage
Target.Validation.Add xlValidateList, Formula1:="=Liste" 'crée la liste de validation
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, P As Range, tablo1, tablo2, ub&, i&, x$, j&
Set T = [Tableau189] 'tableau structuré
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
'---réinitialise les colonnes de T---
Set P = Intersect(Target, T.Columns(1))
If Not P Is Nothing Then Intersect(P.EntireRow, T.Columns(2).Resize(, 4)).ClearContents
Set P = Intersect(Target, T.Columns(2))
If Not P Is Nothing Then Intersect(P.EntireRow, T.Columns(3).Resize(, 3)).ClearContents
'---remplit les 4ème et 5ème colonnes de T---
tablo1 = T.Resize(, 5) 'matrice, plus rapide
tablo2 = [BASE1] 'tableau structuré
ub = UBound(tablo2)
For i = 1 To UBound(tablo1)
x = tablo1(i, 1) & tablo1(i, 2) & tablo1(i, 3)
For j = 1 To ub
If tablo2(j, 1) & tablo2(j, 2) & tablo2(j, 3) = x Then
tablo1(i, 4) = tablo2(j, 4)
If IsNumeric(CStr(tablo2(j, 5))) Then tablo1(i, 5) = CDbl(tablo2(j, 5)) Else tablo1(i, 5) = ""
Exit For
End If
Next j, i
T.Columns(4) = Application.Index(tablo1, , 4)
T.Columns(5) = Application.Index(tablo1, , 5)
Application.EnableEvents = True 'réactive les évènements
End Sub