Combobox multiples avec tri alphabétique et suppression des doublons

**goninph** · 18/09/2019, 16h51

Bonjour,

J'ai trouvé ce code qui fonctionne à merveille avec un combobox, comment répéter ce code pour charger les autres combobox lors de l'initialisation du Userform ?

J'ai dupliqué le code en changeant la source des datas, mais le combobox2 reçoit les 2 sources de data ...

J'ai 26 combobox à initialiser

Merci pour votre aide
Philippe

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
Private Sub UserForm_Initialize()
Dim a As Variant
Dim f As Variant
Dim i As Variant
Dim bd As Variant
Dim mondico As Variant
Dim temp As Variant
        Set f = Sheets("DATA_Interventions")
        Set mondico = CreateObject("Scripting.Dictionary")
        a = f.Range("E3:E" & f.[A65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité
        For i = LBound(a) To UBound(a)
          If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
        Next i
        '--avec tri
        temp = mondico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox1.List = temp
 
         a = f.Range("F3:F" & f.[A65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité
        For i = LBound(a) To UBound(a)
          If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
        Next i
        '--avec tri
        temp = mondico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox2.List = temp
End Sub
Private Sub BT_OK_Click()
    Sheets("Fiche_travail").Range("A2") = ComboBox1
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
Dim ref As Variant
Dim g As Variant
Dim d As Variant
Dim temp As Variant
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

**Transitoire** · 18/09/2019, 18h20

Bonjour, vous nous présentez un code, c'est parfait, mais sans préciser si c'est celui qui fonctionne à merveille ou celui que vous avez modifié???

Vous devriez nous mettre les deux, ainsi nous n'aurions pas besoin d'une boule de cristal pour deviner

Cordialement

**goninph** · 18/09/2019, 19h03

Bonjour,

Dans le code ci-dessous, j'ai dupliqué le code en changeant la source des datas, mais le combobox2 reçoit les 2 sources de data de la colonne E et F ...

Comment modifier ce code pour charger les 26 autres combobox lors de l'initialisation du Userform ?

Merci

**Theze** · 18/09/2019, 20h44

Bonjour,

Voici le code modifié pour les 26 ComboBox nommés CombBox1, ComboBox2, ..., ComboBox26.

mais le combobox2 reçoit les 2 sources de data de la colonne E et F ...

Il te faut vider le dictionnaire avec "RemoveAll" sinon, tu te retrouve avec toutes les données des colonnes :

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
 
Private Sub UserForm_Initialize()
 
    Dim f As Worksheet
    Dim MonDico As Object
    Dim a As Variant
    Dim temp As Variant
    Dim I As Long
    Dim J As Integer
 
    Set f = Sheets("DATA_Interventions")
 
    Set MonDico = CreateObject("Scripting.Dictionary")
 
    'boucle sur les 26 ComboBox
    For J = 1 To 26
 
        'déplace la source de colonne en colonne à partir de la colonne E (1 + 4 = 5)
        a = f.Range(f.Cells(3, J + 4), f.Cells(Rows.Count, J + 4).End(xlUp)) ' tableau a(n,1) pour rapidité
 
        For I = LBound(a) To UBound(a)
            If a(I, 1) <> "" Then MonDico(a(I, 1)) = ""
        Next I
 
        '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
 
        Me.Controls("ComboBox" & J).List = temp
 
        'ici, il est impératif de vider le dictionnaire car sinon, tu te retrouves avec le problème que tu soulèves !
        MonDico.RemoveAll
 
    Next J
 
End Sub

**Thumb down** · 18/09/2019, 22h45

Bonsoir,

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
Private Sub UserForm_Initialize()
'Lst Me.ComboBox1, Sheets("DATA_Interventions").Range("E3")
'Lst Me.ComboBox2, Sheets("DATA_Interventions").Range("G3")
For i = 1 To 26
   Lst Me.Controls("ComboBox" & i), Sheets("DATA_Interventions").Range("E3").Offset(, i - 1)
Next
End Sub
 
Sub Lst(Ls As Object, R As Range)Dim Nom As String
With R.Parent
    Nom = .Name
    Adds = Replace(.Range(R, .Cells(.Cells.Rows.Count, R.Column).End(xlUp)).Address, "$", "")
End With
With CreateObject("Adodb.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=no;"""
    Ls.Column = .Execute("Select Distinct * from [" & Nom & "$" & Adds & "] Order By [F1]").GetRows
    .Close
End With
End Sub

**Ericcool02** · 18/09/2019, 23h10

Bonsoir le forum
Bonsoir goninph, Transitoire, THese & Thumb down

Tu peux essayer comme cela (Reprise d'un code de Jacques BOISGONTIER) :

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
Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Set plage = Feuil1.Range("e3:e" & Feuil1.Range("e65000").End(xlUp).Row)
 
  For Each c In plage
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  Me.ComboBox1.List = MonDico.items
 
        '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox1.List = temp
 
       Set MonDico = CreateObject("Scripting.Dictionary")
        Set plage = Feuil1.Range("f3:f" & Feuil1.Range("f65000").End(xlUp).Row)
  For Each c In plage
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  Me.ComboBox2.List = MonDico.items
 
        '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox2.List = temp
End Sub

Bonne soirée à toutes & à tous
@+ Ericcool02

**goninph** · 19/09/2019, 11h24

Bonjour à tous et merci,

J'ai opté pour la solution de Ericcool02.

Les données sont triées et sans doublons, par contre si il y a une ou plusieurs lignes vides, il y aura un choix vide, est possible de le suppirmer ?
Merci pour votre aide
Philippe

Envoyé par Ericcool02

Bonsoir le forum
Bonsoir goninph, Transitoire, THese & Thumb down

Tu peux essayer comme cela (Reprise d'un code de Jacques BOISGONTIER) :

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
Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Set plage = Feuil1.Range("e3:e" & Feuil1.Range("e65000").End(xlUp).Row)
 
  For Each c In plage
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  Me.ComboBox1.List = MonDico.items
 
        '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox1.List = temp
 
       Set MonDico = CreateObject("Scripting.Dictionary")
        Set plage = Feuil1.Range("f3:f" & Feuil1.Range("f65000").End(xlUp).Row)
  For Each c In plage
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  Me.ComboBox2.List = MonDico.items
 
        '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox2.List = temp
End Sub

Bonne soirée à toutes & à tous
@+ Ericcool02

**Ericcool02** · 19/09/2019, 13h57

Re le forum
Re le fil

Essaie ceci pour retirer les "vides" :

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
Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Set plage = Feuil1.Range("e3:e" & Feuil1.Range("e65000").End(xlUp).Row)
 
  For Each c In plage
  If c.Value <> "" And Not MonDico.Exists(c.Value) Then
  MonDico.Add c.Value, c.Value
   Me.ComboBox1.List = MonDico.items
 
End If
    Next c
    '--avec tri
        temp = MonDico.keys
        Call Tri(temp, LBound(temp), UBound(temp))
        Me.ComboBox1.List = temp
 
       Set MonDico = CreateObject("Scripting.Dictionary")
       Set plage = Feuil1.Range("f3:f" & Feuil1.Range("f65000").End(xlUp).Row)
  For Each c In plage
   If c.Value <> "" And Not MonDico.Exists(c.Value) Then
   MonDico.Add c.Value, c.Value
 
  Me.ComboBox2.List = MonDico.items
End If
  Next c
  '--avec tri
        temp = MonDico.keys
      Call Tri(temp, LBound(temp), UBound(temp))
     Me.ComboBox2.List = temp
  End Sub

Bonne après-midi à toutes & à tous
@+ Ericcool02

**goninph** · 20/09/2019, 00h44

Hello,

Suppression des doublons OK
Tri de A à Z OK
Suppression totale des cellules vides OK

Problème lorsqu'il n'y a pas de données empêche l'initialisation de l'Userform

Faut pas vous prendre la tête, on peut vivre avec une ligne vide

Merci et bonne nuit
Philippe

**Thumb down** · 20/09/2019, 10h14

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
Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Me.ComboBox1.List = ArrayList(Range("E3"))
End Sub
Function ArrayList(R As Range)
Dim Nom As String, coll As Object
Set coll = CreateObject("System.Collections.ArrayList")
With R.Parent
    Nom = .Name
    For Each c In .Range(R, .Cells(.Cells.Rows.Count, R.Column).End(xlUp))
        If CStr(c.Text) <> "" Then
            If Not coll.contains(CStr(c.Text)) Then coll.Add CStr(c.Text)
        End If
    Next
End With
coll.Sort
ArrayList = coll.toarray
'coll.Reverse
End Function

**Ericcool02** · 20/09/2019, 10h34

Bonjour le fil
Bonjour Thumb down

Excellent travail. Tout y est dans un minimum de code. J'achète .... euh j'archive.
@+ Ericcool02

**goninph** · 20/09/2019, 10h59

Hello,

Merci, comment modifier, car E3 est sur une autre feuille

Merci
Philippe

**Thumb down** · 20/09/2019, 11h03

Code :

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

Me.ComboBox1.List = ArrayList(Sheets("DATA_Interventions").Range("E3"))

**goninph** · 20/09/2019, 11h17

ou si toutes les données sont sur la même feuille, c'est correct ?

Code :

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

1
2
3
4
5
6
With Sheets("DATA_Interventions")
            Me.ComboBox_Interv_Civilite.Clear
            Me.ComboBox_Interv_Civilite.List = ArrayList(Range("I3")) 'Voir Function ArrayList(R As Range)
            Me.ComboBox_Interv_Nom.Clear
            Me.ComboBox_Interv_Nom.List = ArrayList(Range("L3")) 'Voir Function ArrayList(R As Range)
End With

**goninph** · 20/09/2019, 11h20

Bonjour Thumb down,

Il y a un soucis lorsque il n'y a pas de donnée dans la colonne.
La Fonction renvoie les données de la cellule en dessus de la ligne 3, soit les titres

Merci
Philippe

**Thumb down** · 20/09/2019, 11h42

désolé!

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
Function ArrayList(R As Range)
Dim Nom As String, coll As Object
Set coll = CreateObject("System.Collections.ArrayList")
With R.Parent
    Nom = .Name
    For Each c In .Range(R, .Cells(.Cells.Rows.Count, R.Column).End(xlUp))
    If c.Row < R.Row Then Exit For
        If CStr(c.Text) <> "" Then
            If Not coll.contains(CStr(c.Text)) Then coll.Add CStr(c.Text)
        End If
    Next
End With
coll.Sort
ArrayList = coll.toarray
'coll.Reverse
End Function

après le With il faut un [.]

Code :

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

1
2
With R.Parent
    SheetName= .Name

Code :

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

1
2
3
4
5
6
With Sheets("DATA_Interventions")
            Me.ComboBox_Interv_Civilite.Clear
            Me.ComboBox_Interv_Civilite.List = ArrayList(.Range("I3")) 'Voir Function ArrayList(R As Range)
            Me.ComboBox_Interv_Nom.Clear
            Me.ComboBox_Interv_Nom.List = ArrayList(.Range("L3")) 'Voir Function ArrayList(R As Range)
 End With

**goninph** · 20/09/2019, 12h07

Un très grand merci pour cet excellent travail c'est fabuleux merci

J'ai encore 2 questions :

Pour la Combobox_civilité Madame Monsieur, comment le charger avec ce 2 mots écrits dans le code
Pour la Combobox_NPA, j'aimerai la remplacer par une textbox qui serait alimentée automatiquement par le Combobox_Ville, sachant que le NPA est dans la colonne R et la ville dans la colonne S.

Bon appétit et encore merci
Philippe

**Thumb down** · 20/09/2019, 12h10

Code :

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

Combobox_civilité.List = Array("Madame","Monsieur")

Combobox_NPA, j'aimerai la remplacer par une ~~textbox~~ Lebel qui serait alimentée automatiquement par le Combobox_Ville,

Combobox_NPA Nouveau Parti Anticapitaliste?

Numéro postal d'acheminement

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
Private Sub Combobox_Ville_Change()
Dim inx As Long
inx = SerchXls(Sheets("DATA_Interventions").Range("A:A"), Sheets("DATA_Interventions").Range("A2"), Combobox_Ville.Text, True) 'Colonne Ville!
If inx > 0 Then Label1.Caption = Sheets("DATA_Interventions").Cells(inx, "R")
End Sub
 
Function SerchXls(MyPlage As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long  On Error Resume Next
Dim CellEntrier As Integer
If EntierCell = True Then CellEntrier = xlWhole Else CellEntrier = xlPart
SerchXls = 0
   SerchXls = MyPlage.Cells.Find(what:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=CellEntrier, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=EntierCell).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function

Envoyé par Ericcool02

Bonjour le fil
Bonjour Thumb down

Excellent travail. Tout y est dans un minimum de code. J'achète .... euh j'archive.
@+ Ericcool02

a ton service!

**goninph** · 20/09/2019, 21h21

Merci infiniment, pas encore pu tester, je suis en déplacement.

Le vba n'ayant plus aucun secret pour vous, pourriez-vous me donner un coup de main sur ce fil de discussion ?

https://www.developpez.net/forums/d2...resse-cellule/

J'ai hâte de pouvoir modifier mon code avec vos propositions

Bonne soirée
Meilleures salutations
Philippe

**Pierre Fauconnier** · 23/09/2019, 07h01

Salut.

Envoyé par goninph

[...]

Le vba n'ayant plus aucun secret pour vous[...]

Il faut noter que l'astuce de Thumb Down, pour efficace qu'elle soit, n'est pas du vba, mais réside dans l'utilisation d'une bibliothèque externe, ici une partie du framework DOT.NET. Il faut donc que ce framework soit installé sur la machine de l'utilisateur (ce qui, je pense, est le cas sur toutes les machines utilisant un Windows "moderne" comme OS). Risquent d'être exclues les ordinateurs tournant sous Mac, par exemple

Il faut donc être prudent avec l'utilisation de ces outils, comme pour toute connexion à une librairie externe (Scripting pour le File System Object ou le Dictionary, par exemple). Personellement, je privilégie toujours les outils du VBA, quitte à se créer "sa" bibliothèque d'outils génériques à réutiliser chaque fois que le besoin le nécessite.

Qui plus est, en travaillant sur Excel, l'alimentation d'une liste devrait normalement s'appuyer sur une conception de classeur bien pensée dans laquelle les données alimentant la liste devraient se trouver dans une table de données, déjà triée et dédoublonnée, éventuellement avec les outils natifs d'Excel.

Cette remarque rejoint celle-ci, dans une discussion du même demandeur, relative à la conception et l'architecture d'une solution pérenne avec Excel/VBA. S'évertuer à tenter de développer quelque chose de pérenne, stable et évolutif sur une conception foireuse de classeur Excel est au minimum du temps perdu. Et je persiste à dire qu'avoir besoin de trier et dédoublonner la source d'une combobox ou d'un listbox relève, dans 99% des cas, d'un problème d'analyse et de conception.

Combobox multiples avec tri alphabétique et suppression des doublons

Macros et VBA Excel

Discussions similaires

Partager

Partager