Multi affichage dans une Listbox

Version imprimable

Bonjour
Dans un Userform j"ai trois Combobox et une Lisbox
Je souhaiterais faire un multiaffichage dans la Listboxselon la sélection dans les Combo.
Exemple
Choix 2016 dans la combobox1 et choix Paris dans la Combobox2 et choix Guitare dans la combobox3 alors
la listbox1 doit afficher les 12 valeurs des lignes correspondant à 2016, Paris et guitare.

J'ai ces codes mais je n'arrive pas à trouver le bon processus.

Merci pour une aide.

A l'initialisation Userform

Code:

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
Private Sub UserForm_Initialize()
 
   Set f = Sheets("bd")
   Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = Rng.Columns.Count
  Set d1 = CreateObject("Scripting.Dictionary")
   Set d2 = CreateObject("Scripting.Dictionary")
   Set d3 = CreateObject("Scripting.Dictionary")
   d1.CompareMode = vbTextCompare
   d2.CompareMode = vbTextCompare
   d3.CompareMode = vbTextCompare
   For i = LBound(BD) To UBound(BD)
    If Not d2.exists(BD(i, 2)) Then
            d2(BD(i, 2)) = ""
        Else
        If Not d1.exists(BD(i, 12)) Then
            d1(BD(i, 12)) = ""
            Else
 
            If Not d3.exists(BD(i, 3)) Then
                d3(BD(i, 3)) = ""
            End If
        End If
    End If
   Next i
 
   '--avec tri
    temp = d1.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox1.List = temp
 
   temp = d2.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox2.List = temp
 
   temp = d3.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox3.List = temp
 
  Me.ListBox1.Clear
   Me.ComboBox1.ListIndex = -1
   Me.ComboBox2.ListIndex = -1
 
  'Me.ListBox1.ColumnCount = 14
  Me.ListBox1.ColumnWidths = "50;60;250;60;50;50;100;50;50;50;200;0;0;0"
  Me.ListBox1.List = BD
 
 
 
 
    Me.Enreg = f.[A65000].End(xlUp).Row + 1
 
   Me.ComboBox5.ColumnCount = 2
   Me.ComboBox5.ColumnWidths = "350,40"
   Me.ComboBox5.RowSource = "ceremonie"
   Me.ComboBox1.ListIndex = 1
   Me.ComboBox2 = "*"
   Me.ComboBox3 = "*"
   F_calendrier2datesForm.Hide
End Sub

Combo1

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub ComboBox1_click()
  Me.ListBox1.Clear
  For K = 1 To Ncol: Me("textBox" & K) = ""
  Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 12), Me.ComboBox1)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox1 = BD(i, 12) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
        'If K >= 3 And K <= 5 Then b(j, K) = Format(BD(i, K), "00 00 00 00 00")
      Next K
      b(j, K) = i
    End If
   Next i
   ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub

Combo2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ComboBox2_click()
 
 
  Me.ListBox1.Clear
  For K = 1 To Ncol: Me("textBox" & K) = "": Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 2), Me.ComboBox2)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox2 = BD(i, 2) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
        'If K >= 3 And K <= 5 Then b(j, K) = Format(BD(i, K), "00 00 00 00 00")
      Next K
      b(j, K) = i
    End If
   Next i
  ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub

Combo3

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ComboBox3_click()
  Me.ListBox1.Clear
  For K = 1 To Ncol
  Me("textBox" & K) = ""
  Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 3), Me.ComboBox3)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox3 = BD(i, 3) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
        'If K >= 3 And K <= 5 Then b(j, K) = Format(BD(i, K), "00 00 00 00 00")
      Next K
      b(j, K) = i
    End If
   Next i
   ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub

listbox1

Code:

1
2
3
4
5
6
7
8
Private Sub ListBox1_Click()
Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
   Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1
 
End Sub

Bonjour
n'est pas très claire autant pour moi
mais si tu cherche à alimenter une listbox en fonction de trois combobox tu peux procéder de la façon suivante :

Code:

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
Private Sub ComboBox3_Change()
Dim V1 As String
Dim V2 As String
Dim V3 As String
V1 = ComboBox1.Value
V2 = ComboBox2.Value
V3 = ComboBox3.Value
Dim plage As Range
Dim plage1 As Range
Dim plage2 As Range
Set plage = Sheets("feuil1").Range("A2:A" & [A65536].End(xlUp).Row)
Set plage1 = Sheets("feuil1").Range("B2:B" & [B65536].End(xlUp).Row)
Set plage2 = Sheets("feuil1").Range("C2:C" & [C65536].End(xlUp).Row)
Tablo = Sheets("Feuil1").Range("A2", "D" & Sheets("Feuil1").Range("D" & Sheets("Feuil1").Rows.Count).End(xlUp).Row)
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 1) = V1 And Tablo(i, 2) = V2 And Tablo(i, 3) = V3 Then
    j = 0
    UserForm1.ListBox1.ColumnCount = 4
    UserForm1.ListBox1.ColumnWidths = "20;20;20;20"
    UserForm1.ListBox1.AddItem
    UserForm1.ListBox1.Column(0, j) = Tablo(i, 1)
    UserForm1.ListBox1.Column(1, j) = Tablo(i, 2)
    UserForm1.ListBox1.Column(2, j) = Tablo(i, 3)
    UserForm1.ListBox1.Column(3, j) = Tablo(i, 4)
    j = j + 1
    End If
Next i
End Sub

Merci pour ta réponse mais ça ne marche pas sur mon userform.
la combobox2 n'affiche rien.

La combobox1 = colonne D
la combobox2 = colonne B
la combobox3 = colonne C

Listbox1 = 12 colonnes

j"ai donc écrit ton code comme ça

Code:

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
Private Sub ComboBox2_change()
 
Dim V1 As String
Dim V2 As String
Dim V3 As String
V1 = ComboBox1.Value
V2 = ComboBox2.Value
V3 = ComboBox3.Value
Dim plage As Range
Dim plage1 As Range
Dim plage2 As Range
Set plage = Sheets("bd").Range("d2:d" & [A65536].End(xlUp).Row)
Set plage1 = Sheets("bd").Range("B2:B" & [B65536].End(xlUp).Row)
Set plage2 = Sheets("bd").Range("C2:C" & [C65536].End(xlUp).Row)
Tablo = Sheets("bd").Range("A2", "L" & Sheets("bd").Range("L" & Sheets("bd").Rows.Count).End(xlUp).Row)
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 4) = V1 And Tablo(i, 2) = V2 And Tablo(i, 3) = V3 Then
    j = 0
    Me.ListBox1.ColumnCount = 12
    Me.ListBox1.ColumnWidths = "50;60;250;60;50;50;100;50;50;50;200;0;0;0"
    Me.ListBox1.AddItem
    Me.ListBox1.Column(0, j) = Tablo(i, 1)
    Me.ListBox1.Column(1, j) = Tablo(i, 2)
    Me.ListBox1.Column(2, j) = Tablo(i, 3)
    Me.ListBox1.Column(3, j) = Tablo(i, 4)
 
    j = j + 1
    End If
Next i
End Sub

Elle est où l'erreur ? :calim2:

merci

1 pièce(s) jointe(s)

Bonjour,

Exemple avec 3 comboBox

Code:

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
 
Dim BD(), ColVisu(), Ncol
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   BD = f.Range("A2:G" & f.[A65000].End(xlUp).Row).Value
   ColVisu = Array(1, 3, 4, 5, 6, 7)    ' colonnes à visualiser
   Ncol = UBound(ColVisu) + 1
   '--- combobox villes trié
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(BD) To UBound(BD)
    d(BD(I, 6)) = ""
   Next I
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox1.List = temp
   Me.ComboBox1.ListIndex = 0
   '--- combobox profession trié
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(BD) To UBound(BD)
    d(BD(I, 7)) = ""
   Next I
   temp = d.keys
   Me.ComboBox2.List = temp
   Me.ComboBox2.ListIndex = 0
   '--- combobox année
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   TriMult BD, LBound(BD), UBound(BD), 3
   For I = LBound(BD) To UBound(BD)
    d(Year(BD(I, 3))) = ""
   Next I
   temp = d.keys
   Me.ComboBox3.List = temp
   Me.ComboBox3.ListIndex = 0
   '-- en têtes de colonne ListBox
   x = 15
   y = Me.ListBox1.Top - 12
   For Each K In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, K)
     Lab.Top = y
     Lab.Left = x
     x = x + f.Columns(K).Width * 1#
     tempCol = tempCol & f.Columns(K).Width * 1# & ";"
   Next
   tempCol = Left(tempCol, Len(tempCol) - 1)
   Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
   Me.ListBox1.ColumnWidths = tempCol
  Affiche
End Sub
 
Private Sub ComboBox1_click()
   Affiche
End Sub
 
Private Sub ComboBox2_click()
   Affiche
End Sub
 
Private Sub ComboBox3_Change()
  Affiche
End Sub
 
Sub Affiche()
  Dim Tbl()
  ville = Me.ComboBox1
  profession = Me.ComboBox2
  an = Me.ComboBox3
  n = 0
  For I = 1 To UBound(BD)
    If BD(I, 6) Like ville And BD(I, 7) Like profession And (Year(BD(I, 3)) = Val(an) Or an = "*") Then
        n = n + 1: ReDim Preserve Tbl(1 To Ncol, 1 To n)
        c = 0
        For Each K In ColVisu: c = c + 1: Tbl(c, n) = BD(I, K): Next K
    End If
  Next I
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.Label3.Caption = Me.ListBox1.ListCount & " Ligne(s)"
  Else
     Me.ListBox1.Clear
     Me.Label3.Caption = ""
  End If
End Sub

Boisgontier
http://boisgontierjacques.free.fr

27/04/2017, 21h36
counterbob
Merci beaucoup
j"ai adapté le code c'est parfait

par contre je souhaiterais renvoyer dans un textbox3 nommé Enreg le numéro de la ligne de la feuille BD lors de la sélection dans la listbox

J"ai essayé ça mais il y a une erreur "impossible de lire la propriété Column. Argument non valide

dans UserForm_Initialize()
Code:

1 2 3 4 Set Rng = f.Range("A1:G" & f.[A65000].End(xlUp).Row) BD = Rng.Value Col = Rng.Columns.Count Me.Enreg = f.[A65000].End(xlUp).Row + 1
Code au clic sur listbox
Code:

1 2 3 4 5 6 7 8 9 Private Sub ListBox1_Click() For K = 1 To UBound(BD, 2) Me("textbox" & K) = Me.ListBox1.Column(K - 1) Next K Me.Enreg = Me.ListBox1.Column(Col) + Rng.Row - 1 End Sub
Merci
28/04/2017, 04h46
boisgontierjacques

2 pièce(s) jointe(s)

Bonjour,

-Dans la version 1, le no de ligne de la BD est est retrouvé avec FIND
-Dans la version 2, le no de ligne de la BD est dans une colonne cachée du ListBox

Boisgontier
http://boisgontierjacques.free.fr
28/04/2017, 18h22
counterbob

Merci
Formidable,
Ton site est d'une grande utilité
Merci encore pour ton altruisme et de partager ton travail.

Je vais maintenant réaliser un champ de recherche par mots, pour afficher le résultat dans la listbox
j'ai vu des exemples sur ton site.

Merci encore