Dim f, a(), mondico
Dim lstObj As ListObject
Dim cel As Range
Private Sub UserForm_Initialize()
Set f = Sheets("DATA")
Set lstObj = f.ListObjects("Tableau1")
For i = 1 To Me.Frame1.Controls.Count
With Me("label" & i)
.Caption = lstObj.HeaderRowRange.Cells(i)
.ForeColor = vbBlack
.Font.Name = "Arial Narrow"
.Font.Bold = True
.Font.Size = 14
.TextAlign = 2
.Top = 6
.Height = 18
.BackColor = vbRed
End With
Next i
Set mondico = CreateObject("Scripting.Dictionary")
For Each C In lstObj.DataBodyRange.Columns(1).Cells
mondico(C.Value) = "" ' on ajoute l'élément de la famille au dictionnaire
Next C
Me.ComboBox1.List = mondico.keys
End Sub
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each cel In lstObj.DataBodyRange.Columns(1).Cells
'For Each cel In f.Range("tableau1[Agence]") 'Ce code marche également
'MsgBox cel.Address & " : " & CStr(cel.Text)
If cel.Text = Me.ComboBox1.Value Then mondico(cel.Offset(, 1).Value) = ""
Next cel
Me.ComboBox2.List = mondico.keys
End Sub
Private Sub ComboBox2_Change()
Me.ComboBox3.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each cel In lstObj.DataBodyRange.Columns(1).Cells
If cel.Text = Me.ComboBox1.Value And cel.Offset(, 1) = Me.ComboBox2 Then mondico(cel.Offset(, 2).Value) = ""
Next cel
Me.ComboBox3.List = mondico.keys
End Sub
Private Sub ComboBox3_Change()
Me.ListBox1.Clear
i = 0
For Each cel In lstObj.DataBodyRange.Columns(4).Cells
If cel.Offset(, -3).Text = Me.ComboBox1.Value And cel.Offset(, -2).Text = Me.ComboBox2.Value And cel.Offset(, -1).Value = Me.ComboBox3 Then
Me.ListBox1.AddItem cel
Me.ListBox1.List(i, 1) = " -- " & cel.Offset(, -1)
i = i + 1
End If
Next cel
End Sub
Private Sub B_ok_Click()
Dim i As Integer
ligne = ActiveCell.Row
For i = 1 To 3
Cells(ligne, i) = Me("combobox" & i)
Next i
Cells(ligne, 4) = Me.ListBox1
For i = 0 To Me.ListBox1.ListCount - 1
Cells(ligne + i, 4) = Me.ListBox1.List(i)
Next i
Unload Me
End Sub