XL 2010 Trier un dictionnaire par ordre alphabétique

[Magic_Doctor]

Bonsoir,

Sur une feuille il y a plusieurs ComboBox. Seuls certains recueillent une liste d’items se trouvant dans la même base de données située sur une autre feuille. Quand on ouvre le classeur, tous les ComboBox concernés par ladite liste sont chargés. Quand on choisit un item dans l’un de ces ComboBox, il disparaît dans la liste des autres ComboBox, de telle sorte qu’il est impossible de choisir par inadvertance plusieurs fois le même item. Jusqu’à présent tout marche bien. Mon seul souci, c’est que je voudrais que les ComboBox présentent une liste triée par ordre alphabétique. En effet, dans la BD cette liste n’est pas forcément ordonnée par ordre alphabétique (comme dans la PJ). J’ai trouvé une fonction (ici) qui, théoriquement, devrait permettre de résoudre ce problème, mais je n’ai pas su l’adapter à l’application.

 

[patricktoulon]

re
Bonjour Chti160
on a eu la même idée
mais ça souleve un autre probleme qui est bien plus grave
imaginons je choisi un item en comboliste1
la comboliste2 doit perdre cet item et ect.. en cascade
imaginons que je change d'avis et je change la comboliste1 et bien le premier item choisi est perdu car il change toute les combo dans ces deux boucles

je pense que ça n'est pas comme ça qu'il faut faire
je pense qu'une variable tableau doit etre créée au depart puis injecter dans les combo et le .listindex doit etre supprimé dans les autres combo au change de l'une d'entre elle
ca serait BEAUCOUP PLUS LEGER !! et catégorique par d'erreurs possibles

 

[ChTi160]

Bonjour Patrick
jean marie

 

[job75]

Bonjour Magic_Doctor, patricktoulon, ChTi160,

Il est en effet bien meilleur d'individualiser chaque liste :

Public NomComboBox$ 'mémorise la variable

Sub CreeListeDispo()
'Mise à jour des ComboBox, dont le nom commence par "ComboListe" (préfixe), de la feuille "Données" qui puisent tous leurs items dans la même base de données (feuille "BD").
'Chaque item ne peut être choisi qu'une fois dans un seul ComboBox ; il disparaît automatiquement des listes des autres ComboBox.
'En somme, on ne peut pas choisir plusieurs fois le même item.
'BOISGONTIER / Magic_Doctor/job75
Dim f1 As Worksheet, f2 As Worksheet, c, liste As Scripting.Dictionary

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set liste = New Dictionary  'le dictionnaire
 
    With f2.Range("ListeItems").Offset(, 2)
        .Value = .Offset(, -2).Value
        .Sort .Cells, xlAscending, Header:=xlNo 'tri
        For Each c In .Cells
            If Len(c) Then liste(c.Value) = "" 'on remplit le dictionnaire
       Next
        .ClearContents
    End With
        
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = "ComboListe" Then _
            If c.Name <> NomComboBox Then If liste.Exists(c.Object.Value) Then liste.Remove c.Object.Value
    Next
 
f1.OLEObjects(NomComboBox).Object.List = liste.Keys
    f1.OLEObjects(NomComboBox).Object.DropDown 'déeoule la liste
End Sub

A chaque activation d'une ComboBox la variable NomComboBox est réinitialisée :

Private Sub ComboListe1_GotFocus()
    NomComboBox = "ComboListe1"
    CreeListeDispo
End Sub

Nota : il n'y a aucune macro Workbook_Open ou Auto _Open.

A+

 

[dysorthographie]

Bonjour,
Scripting.Dictionary date de bien avant System.Collections.SortedList qui lui provient de Dot.net qui à commancé au alentour de 2004!

Sub CreeListeDispo()
'Mise à jour des ComboBox, dont le nom commence par "ComboListe" (préfixe), de la feuille "Données" qui puisent tous leurs items dans la même base de données (feuille "BD").
'Chaque item ne peut être choisi qu'une fois dans un seul ComboBox ; il disparaît automatiquement des listes des autres ComboBox.
'En somme, on ne peut pas choisir plusieurs fois le même item.
'BOISGONTIER / Magic_Doctor

Dim f1 As Worksheet, f2 As Worksheet, c, liste As Object  'Scripting.Dictionary

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set liste = CreateObject("System.Collections.SortedList") 'New Dictionary  'le dictionnaire"
  
    On Error Resume Next        'pour éviter que ça plante si on modifie un item qui est sélectionné dans un des ComboBox
  
    For Each c In f2.Range("ListeItems").Value
        If Len(c) > 0 Then liste(c) = ""  'on rempli le dictionnaire
    Next
          
'************************************ NE MARCHE PAS ************************************
'    liste = SortDictionaryByKey (liste)  'tri, par ordre alphabétique, du dictionnaire
'***************************************************************************************
  
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = "ComboListe" Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que les ComboBox dont le nom commence par "ComboListe"
            If c.Object <> "" Then liste.Remove c.Object.Value
        End If
    Next
    Dim i As Integer, K() As String: ReDim K(liste.Count - 1)
    'K = liste.Keys
    For i = 0 To liste.Count - 1
     K(i) = liste.GetKey(i)
    Next
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = "ComboListe" Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que les ComboBox dont le nom commence par "ComboListe"
            c.Object.List = K
        End If
    Next
End Sub

tu peux également utiliser System.Collections.ArrayList

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set liste = CreateObject("System.Collections.ArrayList") 'New Dictionary  'le dictionnaire"

    On Error Resume Next        'pour éviter que ça plante si on modifie un item qui est sélectionné dans un des ComboBox
    
    For Each c In f2.Range("ListeItems").Value
        If Len(c) > 0 Then If Not liste.Contains(c) Then liste.Add c   'on rempli le dictionnaire
    Next
'*******************************************************************************'   
'Suite du code
'*******************************************************************************'
  
 liste.Sort
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = "ComboListe" Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que les ComboBox dont le nom commence par "ComboListe"
            c.Object.List = liste.ToArray
        End If
    Next
End Sub

 

[Magic_Doctor]

Bonjour patricktoulon, ChTi160, le forum,

En effet, la fusion des 2 boucles aurait dû me sauter aux yeux.
Finalement, ça donnera :

Sub CreeListeDispo(nomCombo$)

Dim f1 As Worksheet, f2 As Worksheet, c, AL As Object

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set AL = CreateObject("System.Collections.ArrayList")
    
    For Each c In f2.Range("ListeItems")  'on dresse l'Array "AL"
       AL.Add c.Text                      'il faut utiliser ".Text" sinon impossible de trier, car on enverrait un "Range"
    Next
    AL.Sort                               'tri, par ordre alphabétique, de l'Array
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
            AL.Remove c.Object.Value
            c.Object.List = AL.ToArray
        End If
    Next
End Sub

bien que l'idée ( de @job75) de tri sur feuile avant reste la meilleure solution et la plus économique

Je n'en doute pas, mais pourquoi trier sur la feuille serait-ce plus performant ?
Quoi qu'il en soit, j'aurais au moins découvert l'objet "System.Collections.ArrayList".

 

[patricktoulon]

re
bonsoir
ben le tri sur feuille est bien plus rapide
mais comme tu dis tu aura appris des trucs c'est l'essentiel
mais intéresse toi aussi a sortedlist qui est ni plus ni mois qu'un dictionnaire avec plus d'option que le dictionnary

 

[job75]

En effet, la fusion des 2 boucles aurait dû me sauter aux yeux.

La fusion des 2 dernières boucles n'est pas une bonne idée car alors la liste n'est pas complètement purgée.

Mais as-tu vu mon post #18 ? La 3ème boucle n'existe plus.

 

[Magic_Doctor]

Bonsoir à tous,

En effet, job, je n'avais pas vu ton post ainsi que ceux qui suivaient. Je n'avais pas rafraîchi.
En fait, ma dernière routine plante, plante, plante... Je retiens donc définitivement la tienne qui marche parfaitement.
En tout cas, ce fil aura été instructif.
Belle macro !