[Résolu] Liste deroulante classée par ordre alphabétique et sans doublons

[Ariochs]

Bonjour,

Me re-voilà ici pour un nouveau problème. J'espère que vous pourrez m'aider

Donc voici ce que je veux faire (tout ce que je veux est sur la feuille "Choix_Prestataires" du classeur) :

Je souhaiterais avoir une liste déroulante de mes entreprises "prestataires" dans chaque cellule de la colonne B.
J'ai donc réussi à créer ma liste qui reprend mes prestataires de la feuille "Societe". J'ai mis cette liste deroulante en C2 de la feuille "Choix_Prestataires". Petit hic, cette liste n'est pas classé par ordre alphabétique et elle comprend des doublons.
Ne voulant pas que ma colonne B (société) dans la feuille "Société" soit classée par ordre alphabétique j'ai donc créé une autre colonne sur ma feuille "Choix_Prestataires" en R afin de recopier la colonne B de société. Une fois fait, j'ai ajouté un code VBA qui me tri par ordre alphabétique cette colonne, cependant elle n'efface pas les doublons, et pour les cases vides j'ai un 0 qui apparait (oui j'ai fait dessendre la colonne jusqu'à la ligne 1500 histoire d'être tranquille pour tout ajout de société).

Du coup avez-vous une idée pour trier ma liste déroulante automatiquement et en supprimant les doublons? (peut-être sans avoir besoin de créer une colonne comme celle en R ? Mais en totu cas je ne veux pas que mes prestataires soient trier dans la feuille société. C'est ici que j'ajoute tout, je veux donc avoir à la fin la dernière société que j'ai ajoutée.

Je vous joints mon fichier pour comprendre un peu mon charabiat.

Merci pour votre aide.

G.

 

[Ariochs]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bon j'ai trouvé le truc pour supprimer les doublons. Enfin presque..

Voilà ce que j'ai :

Private Sub supprimeDoublons()
    MaCellule = "A1"
    Range(MaCellule).Select
    ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
    donnee1 = ActiveCell
    While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
        If ActiveCell = donnee1 Then
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Delete
            donnee1 = ActiveCell
        Else
            donnee1 = ActiveCell
        End If
    Wend
End Sub

Seul problème c'est que j'ai besoin de lancer le code à chaque fois. Est-il possible que le code se lance à chaque ajout de societé? Par exemple quand j'ajoute une société dans l'onglet "Societe", le nom de la societe va s'ajouter dans un autre onglet, qui là tri les sociétés, et me supprime les doublons.

Merci pour votre aide.

 

[Modeste]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour Ariochs,

Pour autant que j'aie bien compris, la procédure suivante crée une liste des sociétés, sans doublons et triée alphabétiquement, en colonne S de ta feuille "Choix_Prestataires". Le code est à placer dans l'objet Feuil5 (là où figurait ta procédure "Worksheet_Change"
La macro s'exécute à chaque activation de la feuille en question.

Private Sub Worksheet_Activate()
Me.Range("S:S").Clear
Set liste = CreateObject("scripting.dictionary")
With Sheets("Societe")
For Each c In .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
    liste(c.Value) = c.Value
Next c
End With
Me.Range("S1:S" & liste.Count) = Application.Transpose(liste.keys)
Me.Range("S1:S" & liste.Count).Sort key1:=Range("S1"), order1:=xlAscending, Header:=xlNo
End Sub

Attention, le code se contente de faire ce que j'ai décrit ci-dessus! A ce stade, la source des "Validation de données" en colonne C de cette même feuille ne sont pas affectées par la macro ... il te reste donc à déterminer ce que tu souhaites faire à ce sujet!

 

[Ariochs]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour,

Merci Modeste pour ton aide. En fait j'ai trouvé une autre méthode cette aprem qui fonctionne plutôt bien, mais qui est super longue :/

Voilà ce que je rentre dans ma cellule :
=INDEX(ListTri;EQUIV(MIN(SI(NB.SI(A$1:A1;ListTri)=0;SI(ListTri<>"";NB.SI(ListTri;SI(A$1="croissant";"<";">")&ListTri);"")));SI(NB.SI(A$1:A1;ListTri)=0;SI(ListTri<>"";NB.SI(ListTri;SI(A$1="croissant";"<";">")&ListTri);""));0))

Mais pour faire ça sur 2000 lignes, c'est ultra long. Quelqu'un sait pourquoi ?

J'essai ta méthode un peu plus tard, mais je n'ai pas tout compris dans ton code

 

[R@chid]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour,

Mais pour faire ça sur 2000 lignes, c'est ultra long. Quelqu'un sait pourquoi ?

C'est une formule matricielle, et les formules matricielles sont gourmandes
Amicalement

 

[Dranreb]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bonsoir.
J'ai de fortes présomptions que mon module MDictionnArbo vous serait d'un grande aide...
Je n'arrête pas de le proposer à tout le monde !

P.S. Pour info: Il peut fabriquer en une seule affectation par un Set un dictionnaire de clés sans doublon classée par ordre alphabétique. les Items sont des tables des numéros de lignes sources. Enfin si une seule colonne est spécifiée du moins: ça n'est vrai que pour la dernière colonne. Les Items des 1ères colonnes sont eux mêmes des dictionnaires pour les colonnes suivantes !
À +

 

[Ariochs]

Re : Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour,

Alors je viens de tester ton code Modeste, il est PAR-FAIT !

C'est ce que je voulais et très rapide à charger. Je te remercie pour ce code.

Dranreb où puis-je trouver ton module MDictionnArbo pour le tester?

Merci pour votre aide.

G.

 

[Misange]

Re : [Résolu] Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour

en retard mais comme j'avais commencé et que l'approche est un peu différente...
Deux solutions
1) la première est sympa et rapide mais ne fonctionne que si la liste des éléments uniques est courte. Elle permet de mettre une liste de validation en récupérant les éléments uniques triés par ordre alpha, SANS passer par une copie de la liste triée dans le classeur.
Il y a malheureusement une limite : les listes de validation n'acceptent que 2 paramètres pour la source : un range (ou une plage nommée ce qui revient au même), ou une chaine de caractère de type 1,2,3, .. (en VBA) qui ne peut pas dépasser 255 caractères, virgules incluses. On arrive vite à cette limite. (mais c'était rigolo de bâtir l'exemple )

J'ai fait un exemple avec une liste plus courte mise sur la page test

2) une solution plus classique, avec un dictionnaire trié en VBA, recopie dans la feuille dans une colonne masquée et utilisation de ce range comme source de validation

Sub listeprestataires_courte()
'Misange 2012
Dim MesPrestataires
Dim UnTri As String

 'première solution, en utilisant directement le résultat du dictionnaire trié
 'comme source pour la validation, sans passer par la feuille
 'valable seulement si il ya peu de prestataires
 'limite : le nom défini ne peut pas comprendre plus de 250 caractères, virgules incluses...
 'pour tester cette solution, une courte liste de prestataires a été créée dans la page test
 
Set MesPrestataires = CreateObject("Scripting.Dictionary")
For Each c In Range("test[test]")
If Not MesPrestataires.Exists(c.Value) Then MesPrestataires.Add c.Value, c.Value
Next c
Temp = MesPrestataires.items
Call Tri(Temp, LBound(Temp), UBound(Temp))
 
For Each i In Temp
    UnTri = UnTri & i
    If a < UBound(Temp) Then UnTri = UnTri & ","
    a = a + 1
Next
 Set dv = Range("choix[prestataires]").Validation
   dv.Delete
   dv.Add xlValidateList, xlValidAlertStop, xlBetween, UnTri
 
 End Sub


Sub listeprestataires_longue()
'Misange 2012
Dim MesPrestataires
Dim UnTri As String

'seconde solution, si le nombre d'items dans le dictionnaire est assez grand
'la liste des éléments uniques et triés est mise dans la colonne Q qui est masquée
With Sheets("choix_prestataires").Columns("Q:Q")
    .EntireColumn.Hidden = True
    .Clear
End With


Set MesPrestataires = CreateObject("Scripting.Dictionary")
For Each c In Range("société[societe]")
If Not MesPrestataires.Exists(c.Value) Then MesPrestataires.Add c.Value, c.Value
Next c
Temp = MesPrestataires.items
Call Tri(Temp, LBound(Temp), UBound(Temp))

With Sheets("choix_prestataires")
.Range("Q1:Q" & MesPrestataires.Count) = Application.WorksheetFunction.Transpose(Temp)
End With

Set dv = Range("choix[prestataires]").Validation
dv.Delete
dv.Add xlValidateList, xlValidAlertStop, xlBetween, "=$Q$1:$Q$" & MesPrestataires.Count

 End Sub



Sub Tri(a, gauc, droi)   ' Quick sort
 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

NB Pour que tout ceci reste dynamique à l'ajout de nouveaux prestataires j'ai mis tout sous forme de tableaux (onglet accueil/style/mettre sous forme de tableau), ce qui évite de se taper de définir des noms dynamiques et en plus facilite la lecture des tableaux.

 

[Dranreb]

Re : [Résolu] Liste deroulante classée par ordre alphabétique et sans doublons

Bonjour.
Vous trouverez le module MDictionnArbo et le module de classe TableIndex nécessaire dans ce classeur.
Cordialement.