Triage ComboBox en ordre alphabétique

[elliotr]

Bonjour à tous,

Je joins le fichier en pièce jointe c'est un fichier test)

J'ai donc des ComboBox qui permettent de choisir des éléments tirés du grand tableau (base de données).
Le code VBA est déjà réalisé, il faudrait juste ajouter de quoi voir les listes dans les ComboBox triée par ordre alphabétique de A à Z.

Suivant le critère de recherche sélectionné à droite, il suffit de sélectionner d'abord dans la CB1 , une fois le choix fait, le ou les choix possible(s) dans a CB2 appait(ssennt), il faudrait trier cela aussi, et ainsi de suite.

J'ai trouvé sur google des parties de code qui permettent le tri mais je n'arrive pas à l'incorporer à mon fichier.

Si quelqu'un aurait la compétence nécéssaire je suis preneur !

Bonne journée.

 

[JNP]

Re : Triage ComboBox en ordre alphabétique

Bonjour Eliotr ,
JB t'as préparé du code "Clef en main" pour ça, regardes ICI
Bonne soirée

 

[elliotr]

Re : Triage ComboBox en ordre alphabétique

Re-bonjour,
J'ai essayé d'appliquer le code à mon fichier mais ça ne fonctionne pas...
Quelqu'un peut-il m'aider svp ?

 

[elliotr]

Re : Triage ComboBox en ordre alphabétique

Up svp, je n'y arrive pas

 

[Dranreb]

Re : Triage ComboBox en ordre alphabétique

Bonjour
Vous n'avez toujours pas répondu à ma dernière proposition, ici.

P.S. Je vois qu'il y a maintenant un groupe de cases à cocher pour changer la priorité des ComboBox.
Or ma classe ComboBoxCasc est équipée d'une méthode (NouvelIndex) qui permet de changer l'ordre.
Mais vous êtes parti dans une direction ou les ComboBox sont banalisés et où il conviendrait plutot de refaire les Add. Pour cela il suffirait de rajouter une méthode permettant de la remettre à 0 la collection de ComboBox. Ou peut être de changer les numéros de colonnes.

Je veux bien vous aider, mais à condition que vous acceptiez le principe de cette utilisation transparente de mes dictionnaires arborescents, dont les clés sont toujours classées. Et donc de commencer par me dire si ce que je vous ai fourni en dernier fonctionne enfin chez vous.

Je rajoute d'ores et déjà cette méthode à ComboBoxCasc:

Public Function Item(ByVal Index As Long) As ComboBoxMembre
Rem. —— Renvoie le membre d'index précisé. Des évènements classiques des ComboBox renvoient déjà un ComboBoxMembre
'  pour information, alors autant pouvoir en demander carrément un aussi. Mais là, le but clairement visé est
'  la manipulation de cet objet par vos soins. Attention: Veillez à ce que vos modifications n'entraveront pas
'  le bon fonctionnement de ce module de classe. Un passage en revue de chaque propriété ne sera pas inutile:
'     Parent:  Modification déconseillée. Pointe sur l'instance du ComboBoxCasc propriétaire.
'     Cbx:     Quoi, vous voudriez lui attribuer un autre ComboBox ? Pourquoi pas après tout.
'     Index:   Modification directe déconseillée: utilisez NouvelIndex pour cela.
'     Col:     La modification possible de la colonne dans la plage source est le principal but cette méthode.
'     Dico:    Modification directe déconseillée: affectez un Dictionnaire arborescent perso complet à Dicarbo.
'  Après modification d'un ensemble de membres ré-exécutez Actualiser.
Set Item = TCBM(Index)
End Function

La modification possible de la colonne dans la plage source est le principal but cette méthode.
Après modification d'un ensemble de membres ré-exécutez Actualiser.

Dites moi s'il faut que je vous aide à l'utiliser ou que je me désabonne de toutes vos discussions.
À +

 

[elliotr]

Re : Triage ComboBox en ordre alphabétique

Bonjour,

J'ai trouvé la solution native à l'aide de quelqu'un.
Merci quand même.

Je met le code pour les intéressés:

Option Explicit
Option Compare Text

Dim NbLignes As Integer
Dim LigDeb As Integer
Dim Noaction As Boolean
Dim MatchLig As Long
Dim Titre(3) As String
Dim TypeRech As Integer
Dim DicoList
Dim DicoLigne
Dim Tablo As Variant
Dim TL As Variant
Dim C0 As String, C1 As String, C2 As String


'tableau du combo1
Public Sub faireList1()
Dim Lig As Long
    VoirColonne
    Set DicoList = CreateObject("Scripting.Dictionary")
    Set DicoLigne = CreateObject("Scripting.Dictionary")
    With Sheets("Base")
        For Lig = LigDeb To NbLignes
            If Not DicoList.Exists(.Cells(Lig, C0).Value) Then
                DicoList.AdD .Cells(Lig, C0).Value, .Cells(Lig, C0).Value
                DicoLigne.AdD Lig, Lig
            End If
        Next Lig
    End With
    Tablo = DicoList.items
    TL = DicoLigne.items
End Sub

'tableau du combo2
Public Sub faireList2()
Dim Lig As Long
    Set DicoList = CreateObject("Scripting.Dictionary")
    With Sheets("Base")
        For Lig = LigDeb To NbLignes
            If .Cells(Lig, C0).Value = ComboBox1.Text Then
                If Not DicoList.Exists(.Cells(Lig, C1).Value) Then
                    DicoList.AdD .Cells(Lig, C1).Value, .Cells(Lig, C1).Value
                End If
            End If
        Next Lig
    End With
    Tablo = DicoList.items
End Sub

Public Sub faireList3()
Dim Lig As Long
    VoirColonne
    Set DicoList = CreateObject("Scripting.Dictionary")
    Set DicoLigne = CreateObject("Scripting.Dictionary")
    With Sheets("Base")
        For Lig = LigDeb To NbLignes
            If .Cells(Lig, C0).Value = ComboBox1.Text And .Cells(Lig, C1).Value = ComboBox2.Text Then
                If Not DicoList.Exists(.Cells(Lig, C2).Value) Then
                    DicoList.AdD .Cells(Lig, C2).Value, .Cells(Lig, C2).Value
                    DicoLigne.AdD Lig, Lig
                End If
            End If
        Next Lig
    End With
    Tablo = DicoList.items
    TL = DicoLigne.items
End Sub
Sub VoirColonne()
    Select Case TypeRech
    Case 0: C0 = "AO": C1 = "AN": C2 = "A"
    Case 1: C0 = "AN": C1 = "AO": C2 = "A"
    Case 2: C0 = "A": C1 = "AO": C2 = "AN"
    Case 3: C0 = "A"
    End Select
End Sub

'Remplir et vider tout les TextBox
Sub InitFormulaire(Optional Mode As Boolean = False)
Dim Ctl As Control

    With Sheets("Base")
    'Boucle sur tout les contrôle de l'UF
    'Ctl étant une variable objet se substitue au control
    For Each Ctl In Me.Controls
        'Si la propriété TAG d'un contrôle n'est pas vide c'est que c'est un TextBox
        'Note : Les propriétés TAG des texBox concernés sont initialiser
        'Avec les N° de colonne où il doivent "pécher" la donnée
        If Ctl.Tag <> "" Then
            'mode =true --> Vider les textBox
            If Mode Then 'si Mode = true vide le Textbox
                Ctl = ""
            Else 'remplir le textbox avec la donnée de la BD qui se trouve à la ligne
                 'MatchLig, le N° de la colonne est dans le TAG
                 'Cint transforme la valeur de la propriété TAG qui est en String
                 'en valeur numérique compatible avec un N° de colonne
                Ctl = Cells(MatchLig, CInt(Ctl.Tag)).Value
            End If
        End If
    Next Ctl
    End With
End Sub

Sub VoirControl(Mode As Boolean)
    ComboBox2.Visible = Mode
    ComboBox3.Visible = Mode
    TitCB2.Visible = Mode
    TitCB3.Visible = Mode
End Sub

Private Sub ComboBox1_Change()
    If Noaction Then Exit Sub 'désactive l'évenement
    If TypeRech = 3 Then
        MatchLig = TL(ComboBox1.ListIndex)
        'Rempli le formulaire
        InitFormulaire
    Else
        faireList2
        Trier Tablo, LBound(Tablo), UBound(Tablo)
        ComboBox2.List = Tablo
    End If
End Sub

Private Sub ComboBox2_Change()
    If Noaction Then Exit Sub 'désactive l'évenement
    InitFormulaire True 'vide le formulaire
    faireList3
    TrierFIN Tablo, LBound(Tablo), UBound(Tablo)
    ComboBox3.List = Tablo
End Sub

Private Sub ComboBox3_Change()
    If Noaction Then Exit Sub 'désactive l'évenement
    'Initialise le N° de la ligne où se situe les données
    MatchLig = TL(ComboBox3.ListIndex)
    'Rempli le formulaire
    InitFormulaire
End Sub

Private Sub Frame2_Click()

End Sub

Private Sub OptionButton1_Click()
    InitFormulaire True 'vide le formulaire
    TypeRech = 0
    Remplir1
End Sub

Private Sub OptionButton2_Click()
    InitFormulaire True 'vide le formulaire
    TypeRech = 1
    Remplir1
End Sub

Private Sub OptionButton3_Click()
    InitFormulaire True 'vide le formulaire
    TypeRech = 2
    Remplir1
End Sub

Private Sub OptionButton4_Click()
    InitFormulaire True 'vide le formulaire
    TypeRech = 3
    InitLesCombo
    faireList1
    TrierFIN Tablo, LBound(Tablo), UBound(Tablo)
    ComboBox1.List = Tablo

  '  Remplir1
End Sub

Private Sub UserForm_Initialize()
Dim i
    'Initialise le tableau Titre() pour les label audessus des combo
    Titre(0) = "Sociétés,Banques,Codes"
    Titre(1) = "Banques,Sociétés,Codes"
    Titre(2) = "Codes,Sociétés,Banques"
    Titre(3) = "Code uniquement," & Chr(32) & "," & Chr(32)
    'Nombre de ligne dans la BD
    NbLignes = Sheets("Base").Range("AN65536").End(xlUp).Row
    LigDeb = 3 'N° de ligne où commencer
    Remplir1
End Sub

Sub Remplir1()
    Noaction = True
    InitLesCombo
    faireList1
    Trier Tablo, LBound(Tablo), UBound(Tablo)
    ComboBox1.List = Tablo
    Noaction = False
End Sub

Sub InitLesCombo()
Dim TB
    'Vider tout les combo
    ComboBox1.Clear: ComboBox2.Clear: ComboBox3.Clear
    ComboBox2.Visible = Not TypeRech = 3
    ComboBox3.Visible = Not TypeRech = 3
    'Changer les titres des combobox suivant le choix du tri
    TB = Split(Titre(TypeRech), ",")
    TitCB1 = TB(0): TitCB2 = TB(1): TitCB3 = TB(2)
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton3_Click()
    Unload Me
    UserForm1.Show
End Sub

Private Sub CommandButton2_Click()
Set Ws = Sheets.AdD
Ws.PageSetup.Orientation = xlLandscape
Ws.Paste
ActiveSheet.PageSetup.CenterHorizontally = True
ActiveSheet.PageSetup.CenterVertically = True
UserForm1.PrintForm
End Sub


' Trier par le milieu et mémorise la ligne cible
' Trie les nombres en ordre croissant (ce qu'Excel ne fait pas)
Sub TrierFIN(ByRef TBCB, AdG, AdD)
Dim Ml
Dim Ag, Ad, Buff
    Ml = TBCB((AdG + AdD) \ 2)
    Ag = AdG: Ad = AdD
    Do
        Do While Cmp(Ml, TBCB(Ag)): Ag = Ag + 1: Loop
        Do While Cmp(TBCB(Ad), Ml): Ad = Ad - 1: Loop
        If Ag <= Ad Then
          Buff = TBCB(Ag): TBCB(Ag) = TBCB(Ad): TBCB(Ad) = Buff
          Buff = TL(Ag): TL(Ag) = TL(Ad): TL(Ad) = Buff
          Ag = Ag + 1: Ad = Ad - 1
        End If
    Loop While Ag <= Ad
    If Ag < AdD Then Call TrierFIN(TBCB, Ag, AdD)
    If AdG < Ad Then Call TrierFIN(TBCB, AdG, Ad)
End Sub

' Trier par le milieu ,suivant une idée de Jacques Boisgontier
' Trie les nombres en ordre croissant (ce qu'Excel ne fait pas)
Sub Trier(ByRef TBCB, AdG, AdD)
Dim Ml
Dim Ag, Ad, Buff
    Ml = TBCB((AdG + AdD) \ 2)
    Ag = AdG: Ad = AdD
    Do
        Do While Cmp(Ml, TBCB(Ag)): Ag = Ag + 1: Loop
        Do While Cmp(TBCB(Ad), Ml): Ad = Ad - 1: Loop
        If Ag <= Ad Then
          Buff = TBCB(Ag): TBCB(Ag) = TBCB(Ad): TBCB(Ad) = Buff
          Ag = Ag + 1: Ad = Ad - 1
        End If
    Loop While Ag <= Ad
    If Ag < AdD Then Call Trier(TBCB, Ag, AdD)
    If AdG < Ad Then Call Trier(TBCB, AdG, Ad)
End Sub

Reste encore une interrogation.
Si quelqu'un ici saurait me détailler les fonctions/lignes de codes en précision pour que je comprenne tout, ça serait super.

A plus tard.