Création d'une liste de choix sans doublons

[Kracter56]

Bonjour,

Je dois développer un outil qui doit proposer des choix séléctifs
à l'utilisateur sachant qu'il doit y avoir 3 combobox dépendantes
les unes des autres.

J'ai un fichier de 3 colonnes d'un millier de lignes à traiter sans
doublons.

L'idée serait de créer des extractions sans doublonspour chaque colonne
et développer un algorithme qui montre les différentes possibilités
en fonction des choix.

Seulement, je suis incapable de faire une liste sans doublons

Auriez-vous une idée à me proposer svp? Je suis débutant. Merci.

 

[jeanpierre]

Re : Création d'une liste de choix sans doublons

Bonjour Kracter56, Bienvenue sur le forum XLD,

Déjà, regarde en bas de cette page dans les cinq discussions similaires et ensuite, si tu ne trouves pas, utilise la Recherche, en haut à droite sous ton pseudo et pour finir, regarde ce lien aussi, tu y trouveras réponses à ta question :

Formation Excel VBA JB (choisir la bonne option dans le sommaire)

Bon après-midi.

Jean-Pierre

 

[job75]

Re : Création d'une liste de choix sans doublons

Bonjour Kracter56, salut jeanpierre,

Grâce à Jacque Boisgontier, j'ai appris, et retenu, l'usage de "Scripting.Dictionary" en VBA pour créer des listes sans doublons.

Dans le code de l'UserForm (je suppose que c'est là où se trouvent vos ComboBox) mettez celui-ci qui s'exécute lors de son ouverture :

Private Sub UserForm_Initialize()
Dim d1 As Object, d2 As Object, d3 As Object, cel As Range

Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")

For Each cel In Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
If cel <> "" And Not d1.exists(cel.Value) Then d1.Add cel.Value, cel.Value
If cel.Offset(, 1) <> "" And Not d2.exists(cel.Offset(, 1).Value) Then d2.Add cel.Offset(, 1).Value, cel.Offset(, 1).Value
If cel.Offset(, 2) <> "" And Not d3.exists(cel.Offset(, 2).Value) Then d3.Add cel.Offset(, 2).Value, cel.Offset(, 2).Value
Next

ComboBox1.List = Application.Transpose(d1.items)
ComboBox2.List = Application.Transpose(d2.items)
ComboBox3.List = Application.Transpose(d3.items)

End Sub

L'analyse en Feuil1 commence en ligne 2 et se continue jusqu'à la dernière valeur en colonne A.

A+

 

[job75]

Re : Création d'une liste de choix sans doublons

Re,

Autre chose apprise (j'allais l'oublier) de Jacques Boisgontier, l'utilisation d'un tableau qui remplace la plage de cellules et permet de gagner beaucoup en temps d'exécution :

Private Sub UserForm_Initialize()
Dim [COLOR="Red"]tablo[/COLOR], d1 As Object, d2 As Object, d3 As Object, i As Long

tablo = Sheets("Feuil1").Range("A2:C" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")

For i = LBound(tablo) To UBound(tablo)
[COLOR="Red"]If tablo(i, 1) <> "" Then d1(tablo(i, 1)) = tablo(i, 1)
If tablo(i, 2) <> "" Then d2(tablo(i, 1)) = tablo(i, 2)
If tablo(i, 3) <> "" Then d3(tablo(i, 1)) = tablo(i, 3)[/COLOR]
Next

ComboBox1.List = Application.Transpose(d1.items)
ComboBox2.List = Application.Transpose(d2.items)
ComboBox3.List = Application.Transpose(d3.items)

End Sub

Edit : simplifié le code en rouge (je n'utilise plus exists et Add)

A+

 

[Kracter56]

Re : Création d'une liste de choix sans doublons

Bonjour à tous,

Tout d'abord merci pour vos réponses.

Job75> Merci pour tes solutions, je vois que ça fonctionne.

Mais comment faut-il procéder pour faire que la liste de la combobox2
dépende de la combobox et que la liste de combobox3 dépende des combobox1 et 2?

Merci pour vos réponses.

 

[BOISGONTIER]

Re : Création d'une liste de choix sans doublons

Bonjour,

Menus en cascade

Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  Me.ComboBox1.List = MonDico.items
End Sub

Private Sub ComboBox1_Change()
  Set f = Sheets("BD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    If c = Me.ComboBox1 Then
      temp = c.Offset(, 1)
      If Not MonDico.Exists(temp) Then MonDico.Add temp, temp
   End If
  Next c
  Me.ComboBox2.List = MonDico.items
  Me.ComboBox2.ListIndex = -1
  Me.ComboBox3.ListIndex = -1
End Sub

Private Sub ComboBox2_Change()
  Set f = Sheets("BD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    If c = Me.ComboBox1 And c.Offset(, 1) = Me.ComboBox2 Then
      temp = c.Offset(, 2)
      If Not MonDico.Exists(temp) Then MonDico.Add temp, temp
    End If
   Next c
   Me.ComboBox3.List = MonDico.items
End Sub

JB