Discussion :

[Lyricslife]

Salut a tous !

Nouveau weekend, nouvelle question

D'abord je m'excuse, je suis sur clavier QWERTY et n'ai donc pas les accents.

Alors voila je dispose d'un classeur Excel avec en colonne A les clients, et en colonne B les mots cles lies a ces clients.
Cela signifie qu'en colonne A, un meme client peut apparaitre plusieurs fois mais avec un mot cle different en colonne B.

J'aimerai creer un userform avec une ComboBox qui me liste les clients en A sans doublons, et une ListBox qui repertorie tous les mots cles relies au client selectionne avec la ComboBox.

Mon userform est deja cree, je sais comment remplir ma ComboBox avec les clients sans les doublons en utilisant un dictionnaire, mais je n'arrive pas a lier les mots cles de chaque clients dans ma ListBox.
Je sais le faire lorsqu'il n'y a qu'une ligne par client et que tous les mots cles sont listes par colonnes.

Mon code :

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
Private Sub UserForm_Initialize()
Dim wb As Workbook, sh As Worksheet, i As Long
 
Set wb = ThisWorkbook
Set sh = Sheet1
 
i = sh.Range("A" & Rows.Count).End(xlUp).row
 
For x = 2 To i
    If IsError(sh.Range("A" & x)) Then sh.Range("A" & x) = "N/A"
Next x
 
Me.ComboBox1.Clear
 
Call FillCombo(ComboBox1, sh.Range("A2:A" & i))
End Sub
 
Sub FillCombo(combo As ComboBox, rg As Range)
Dim dict As Object, C As Range, Item As String
 
Set dict = CreateObject("Scripting.Dictionary")
 
For Each C In rg
    Item = Trim(C.Value)
 
        If dict.Exists(Item) = False Then
            dict.Add Item, 1
            combo.AddItem Item
        End If
Next
 
Set dict = Nothing
End Sub
 
Private Sub ComboBox1_Change()
FillKeywordsList ComboBox1.ListIndex
End Sub
 
 
Sub FillKeywordsList(ByVal row As Long)
Dim rg As Range
 
Set rg = Sheet1.Range("B2:H2").Offset(row)
 
ListBox1.Clear
ListBox1.List = WorksheetFunction.Transpose(rg)
End Sub

Au lieu de tenter d'expliquer par les mots, je vous mets en piece jointe un exemple.
Le but est donc de faire fonctionner mon code avec les valeurs telles qu'elles sont presentees dans l'onglet "fonctionne pas".

Tant que j'y suis, y a t-il un moyen de trier les valeurs de la ComboBox ? De la ListBox ? Par ordre alphabetique.

Merci infiniment pour votre aide precieuse

[clementmarcotte]

Salut a tous !


D'abord je m'excuse, je suis sur clavier QWERTY et n'ai donc pas les accents.

Juste à prendre le clavier Français-Canada ou le clavier canadien multilingue. Ils ont tous les accents français et ils sont Qwerty.

[boisgontierjacques]

Bonjour,

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
 
Dim f, BD()
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  BD = f.Range("A2:B" & f.[B65000].End(xlUp).Row).Value ' Array BD() pour rapidité
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(BD)             ' on explore la colonne de niveau 1
    d(BD(i, 1)) = ""                  ' on ajoute l'élément de la famille au dictionnaire
  Next i
  Me.ComboBox1.List = d.keys
  Me.ListBox1.List = BD
End Sub
 
Private Sub ComboBox1_click()
  Me.ListBox1.Clear
  For i = 1 To UBound(BD)
    If BD(i, 1) = Me.ComboBox1 Then Me.ListBox1.AddItem BD(i, 2)
  Next i
End Sub

Boisgontier

[Transitoire]

Bonjour, pardonnez moi de déborder un peu.
Juste pour signaler a BoisgontierJacques: Sur mon Mac(10.6) La macro plante et un message signale erreur d'éxécution 429, un composant ActiveX ne peut pas créer d'objet?
Est-ce une particularité de la version Mac?
Cordialement

[boisgontierjacques]

Cf version MAC ( avec Collection au lieu de Dictionary)

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
 
Dim f, BD()
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  BD = f.Range("A2:B" & f.[B65000].End(xlUp).Row).Value ' Array BD() pour rapidité
  tblclé = Application.Transpose(f.Range("B2:B" & f.[B65000].End(xlUp).Row).Value)
  a = SansDoublonsMAC(tblclé)
  Me.ComboBox1.List = SansDoublonsMAC(tblclé)
End Sub
 
Private Sub ComboBox1_click()
  Me.ListBox1.Clear
  For i = 1 To UBound(BD)
    If BD(i, 2) = Me.ComboBox1 Then Me.ListBox1.AddItem BD(i, 1)
  Next i
End Sub
 
Function SansDoublonsMAC(a)
  Dim Maliste As New Collection
  On Error Resume Next
  For i = LBound(a) To UBound(a)
     Maliste.Add Item:=a(i), Key:=a(i)
  Next i
  On Error GoTo 0
  Dim b(): ReDim b(1 To Maliste.Count)
  For i = 1 To Maliste.Count
    b(i) = Maliste(i)
  Next i
  SansDoublonsMAC = b
End Function

Boisgontier

[Lyricslife]

Bonjour et merci pour vos réponses !

@EricKergresse, cela marche parfaitement et les valeurs sont même triées ! Je vais étudier ce code de plus près ! Un grand merci !

@boisgontierjacques, j'ai pu adapter le code à mon fichier et cela marche également
Suite à cela, afin de mieux comprendre, plusieurs questions me viennent a l'esprit :

1. quelle est la DIM de BD ? Lorsque j'essaye d'afficher sa valeur dans un msgbox ou un debug.print j'ai un message d'erreur ;
2. à quel moment le tri des doublons est-il effectué ?
3. je ne comprends pas cette partie du code : d(BD(i, 2)) = "", pourquoi = "" ?
4. comment dois-je annoncer la variable ColTri dans la Sub TriMultiCol ?

Encore merci pour vos réponses !

[Invité]

Bonjour,

Une solution possible dans le fichier joint.