Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ncol_liste&, tList As ListObject, nom, maListe As String, Valeur
If Intersect(Target, Range("b:d")) Is Nothing Then Exit Sub 'sélection hors colonne B à D, on quitte
If Target.Count <> 1 Then Exit Sub 'plus d'une cellule sélectionnée, on quitte
If Target.Row = 1 Then Exit Sub 'si sélection ent ligne 1 (titres), on quitte
Valeur = Target 'valeur du membre de l'équipe
Target.Validation.Delete 'on efface la liste de validation de target
If Cells(Target.Row, "a") = "" Then Exit Sub 'si en colonne A la valeur est vide, on quitte
ncol_liste = Range("g1").Column + 3 * (Target.Column - 2) 'n° de la colonne de la liste
'construction de la liste de validation
Set tList = Cells(1, ncol_liste).ListObject ' tableau structuré équipe en fonction de la de la colonne de la cellule sélectionnée
For Each nom In tList.DataBodyRange.Columns(1).Cells 'pour chaque membre de l'équipe
If nom <> "" Then 'si le nom du membre n'est pas vide
If IsError(Application.Match(nom, Columns(Target.Column), 0)) Then 'si le membre n'est pas déjà sue un poste
If nom.Offset(, 1) = 1 Then maListe = maListe & "," & nom & "," 'on ajoutre le membre à la liste des membres possibles
End If
End If
Next nom
' si l'équipier déjà choisi n'est plus parmi les présents, on l'ôte de la liste des possibles
If Valeur <> "" Then If InStr("," & Valeur & ",", maListe) = 0 Then maListe = Replace(maListe, "," & Valeur & ",", "")
If maListe <> "" Then 'si la liste des possibles n'est pas nulle
With Target.Validation
'on retire la virgule en tête de liste et fin de liste et on remplace les doubles virgules par une simple virgule
maListe = Replace(Mid(Left(maListe, Len(maListe) - 1), 1), ",,", ",")
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Mid(maListe, 2) 'on définit la liste de validation
End With
End If
End Sub
,
