Discussion :

[Invité]

bonjour
besoin de votre aide
dans un formulaire de veux faire des listes déroulantes en cascade avec des combobox, je les ai fais mais il me reste un problème: dans les combobox je veux pas voir les valeur répéter comme la cmbobox1
le 2ème problème je veux filtrer mas liste box avec les 3 combobox
voici le fichier

[ARTURO83]

Bonjour,

Essayez ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Option Explicit
Dim T1
Dim Ws As Worksheet
Dim NbLignes As Integer
 
Private Sub ComboBox1_Change()
    Dim J As Long
    Me.ComboBox2.Clear   'Efface les données de la combobox2
    Me.ComboBox3.Clear   'Efface les données de la combobox3
    Me.lstMulti.Clear      ' Efface la listBox
    If Me.ComboBox1.ListIndex = -1 Then Exit Sub
    Dim Mondico As Object
    Set Mondico = CreateObject("Scripting.dictionary")
    For J = 5 To NbLignes
        If Ws.Range("P" & J) = Me.ComboBox1 Then Mondico(Ws.Range("Q" & J).Value) = ""
    Next J
    With Me.ComboBox2
        If Mondico.Count > 0 Then
            .List = Application.Transpose(Mondico.keys)
        End If
    End With
End Sub
 
Private Sub ComboBox2_Change()
    Dim J As Long
    Me.ComboBox3.Clear   'Efface les données de la combobox3
    Me.lstMulti.Clear      ' Efface la listBox
    If Me.ComboBox2.ListIndex = -1 Then Exit Sub
    Dim Mondico As Object
    Set Mondico = CreateObject("Scripting.dictionary")
    For J = 5 To NbLignes
        If Ws.Range("Q" & J) = Me.ComboBox2 Then Mondico(Ws.Range("R" & J).Value) = ""
    Next J
    With Me.ComboBox3
        If Mondico.Count > 0 Then
            .List = Application.Transpose(Mondico.keys)
        End If
    End With
End Sub
 
Private Sub ComboBox3_Change()
    Dim J As Long, I As Integer, Indice As Integer, T2()
    On Error Resume Next
    Me.lstMulti.Clear
    Indice = 0
    T1 = Range("A5:R" & [A1000].End(xlUp).Row)
    For J = LBound(T1) To UBound(T1)
        If T1(J, 16) Like Me.ComboBox1 & "*" And T1(J, 17) Like Me.ComboBox2 & "*" And T1(J, 18) Like Me.ComboBox3 & "*" Then
            Indice = Indice + 1
            ReDim Preserve T2(1 To 9, 1 To Indice)
            For I = 1 To UBound(T1, 2)
                T2(I, Indice) = T1(J, I)
            Next I
        End If
    Next J
    If Indice > 0 Then
        Me.lstMulti.Column = T2
    Else
        Me.lstMulti.Clear      ' On supprime l'enregistrement par défaut
    End If
End Sub
 
Private Sub UserForm_Initialize()
    Me.lstMulti.ColumnHeads = False
    Me.lstMulti.List() = Range(Worksheets("nouv").Cells(5, 18), Worksheets("nouv").Cells(Worksheets("nouv").Range("A1000").End(xlUp).Row, 1)).Value
    Set Ws = Worksheets("nouv")
    NbLignes = Ws.Range("P65536").End(xlUp).Row
    With Me.ComboBox2
        .ColumnCount = 2
        .ColumnWidths = "-1;0"
    End With
    With Me.ComboBox2
        .ColumnCount = 2
        .ColumnWidths = "-1;0"
    End With
    InitCombo1 'Lance le programme InitCombo1 développé ci-desous
End Sub
 
Sub InitCombo1()
    Dim J As Long
    Dim Mondico As Object
    Set Mondico = CreateObject("Scripting.dictionary")
    For J = 5 To NbLignes
        Mondico(Ws.Range("P" & J).Value) = ""
    Next J
    With Me.ComboBox1
        .Clear
        If Mondico.Count > 0 Then
            .List = Application.Transpose(Mondico.keys)
        End If
    End With
End Sub

Avec le fichier
Pièce jointe 462644

Cdlt

[Invité]

merci bcp mr ARTURO83