Const sSh = "TST1", sSource = "A:B", sCellMatricule = "E3", sCellNom = "F3"
Dim Matricules As New Scripting.Dictionary, Plage As Range
Dim Sh As Worksheet, CellNom As Range
Public Source As Range, CellMatricule As Range
Sub InitVar()
Set Sh = ThisWorkbook.Sheets(sSh)
With Sh
Set Source = Sh.Range(sSource)
Set CellMatricule = Sh.Range(sCellMatricule)
Set CellNom = Sh.Range(sCellNom)
Set Plage = .Cells(.Rows.Count, Source.Column).End(xlUp)
Set Plage = .Range(Source(2, 1), Plage.Offset(, 1))
End With
End Sub
Sub CreerDico()
Dim xcell As Range
If (Source Is Nothing) Or (CellNom Is Nothing) Then InitVar
Matricules.RemoveAll
For Each xcell In Plage.Resize(, 1)
If Matricules.Exists(xcell.Value) Then
Matricules(xcell.Value) = Matricules(xcell.Value) & "," & xcell.Offset(, 1).Value
Else
Matricules(xcell.Value) = xcell.Offset(, 1).Value
End If
Next xcell
End Sub
Sub ValidationMatricule()
Dim Aux, i&
Aux = Matricules.Keys
Qsort Aux, LBound(Aux), UBound(Aux)
'Verif si actuel matricule existe
If Not Matricules.Exists(CellMatricule.Value) Then CellMatricule = ""
With CellMatricule.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(Aux, ",")
End With
End Sub
Sub ValidationNom()
Dim auxMatr, auxNoms, i&, S, Z
auxMatr = Plage.Resize(, 1).Value
auxNoms = Plage.Offset(, 1).Resize(, 1).Value
For i = 1 To UBound(auxMatr)
If auxMatr(i, 1) = CellMatricule Then
S = S & "," & auxNoms(i, 1)
End If
Next i
S = S & "," & "------------"
For i = 1 To UBound(auxMatr)
If auxMatr(i, 1) <> CellMatricule Then
S = S & "," & auxNoms(i, 1)
End If
Next i
If Left(S, 1) = "," Then S = Mid(S, 2)
With CellNom.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=S
End With
'Vérif valeur de Nom par rapport au matricule
If CellMatricule = "" Or Left(CellMatricule, 2) = "--" Then
CellNom = ""
CellMatricule.Activate
Else
Z = "," & CellNom & ","
If InStr("," & Matricules.Item(CellMatricule.Value) & ",", Z) = 0 Then
CellNom = Split(Matricules.Item(CellMatricule.Value), ",")(0)
CellNom.Activate
End If
End If
End Sub