Trier une combobox alimenté par fichier dynamique

Carnage029

XLDnaute Occasionnel
Bonjour à tous, je viens une fois de plus vous demander de l'aide :)

J'ai une combobox qui est alimenté comme suit :

Code:
Dim MonRepertoire, fa, fe, x As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    chem = "C:\mondossier"
    MonRepertoire = chem & importcombo.siglecombobox.Text
    x = 1
    For Each fa In fso.GetFolder(MonRepertoire).Files
        lsigle = Len(importcombo.siglecombobox.Text)
        ldevise = Len(importcombo.devisecombobox.Text)
        fe = fa.Name
        fe = Mid(fe, lsigle + ldevise + 5, 6)
        importcombo.date1combobox.AddItem fe
        x = x + 1
    Next fa

Et je souhaiterai que les proposition de la combobox date1combobox soit faite de manière bizarre,

Je vous explique, les proposition qui rentrent après l'alimentation sont toutes au format "jjmmaa" hors ce format n'est pas une date reconnue, je souhaiterai les trier, (il s'agit forcément de dates passés ou de la date d'auhourd'hui au plus récent) de la plus récente tout en haut des choix à la plus ancienne, la plus en bas du menu défilant :D

Je vous remercie encore, ce forum est vraiment bien pour progresser et apprendre à son rythme :)
 

tototiti2008

XLDnaute Barbatruc
Re : Trier une combobox alimenté par fichier dynamique

Bonjour Carnage,

Sur le principe, il faut placer les données fe dans un tableau puis lancer un algorithme de tri de ton tableau avant, enfin, d'alimenter ta combobox par les données du tableau
Voir par là pour les tris, par exemple

Les tableaux
 

Carnage029

XLDnaute Occasionnel
Re : Trier une combobox alimenté par fichier dynamique

Comme ça ? et je place ou mon algo de tri ? à quelle ligne ?

Code:
    importcombo.devisecombobox.Clear

    Dim MonRepertoire, fa, fe, x As Integer, Dico, Tablo
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dico = CreateObject("Scripting.Dictionary")
    chem = Sheets("system").Range("A25").Value
    MonRepertoire = chem & importcombo.siglecombobox.Text
    x = 1
    For Each fa In fso.GetFolder(MonRepertoire).Files
        lsigle = Len(importcombo.siglecombobox.Text)
        fe = fa.Name
        fe = Mid(fe, lsigle + 2, 3)
        Dico(fe) = fe
        x = x + 1
    Next fa
    Tablo = Dico.keys
    Set Dico = Nothing
    Set fso = Nothing
    For x = LBound(Tablo) To UBound(Tablo)
        importcombo.devisecombobox.AddItem Tablo(x)
    Next x
 

tototiti2008

XLDnaute Barbatruc
Re : Trier une combobox alimenté par fichier dynamique

Re,

ça c'est si tu veux aussi supprimer les doublons, comme demandé dans ton autre fil du jour

un essai, toujours à l'aveugle, sur la base du tri de Boisgontier

Code:
Sub tri(a() As Double, 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


Sub MaMacro()
    importcombo.devisecombobox.Clear

    Dim MonRepertoire, fa, fe, x As Integer, Dico, Tablo, Dte as Date
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dico = CreateObject("Scripting.Dictionary")
    chem = Sheets("system").Range("A25").Value
    MonRepertoire = chem & importcombo.siglecombobox.Text
    x = 1
    For Each fa In fso.GetFolder(MonRepertoire).Files
        lsigle = Len(importcombo.siglecombobox.Text)
        fe = fa.Name
        fe = Mid(fe, lsigle + 2, 3)
        Dte = Dateserial(2000 + cint(right(fe,2)), cint(mid(fe,3,2)), cint(left(fe,2)))
        Dico(CLng(Dte)) = Clng(Dte)
        x = x + 1
    Next fa
    Tablo = Dico.keys
    Tri(Tablo, lbound(tablo), ubound(tablo))
    Set Dico = Nothing
    Set fso = Nothing
    For x = LBound(Tablo) To UBound(Tablo)
        importcombo.devisecombobox.AddItem format(Tablo(x),"DDMMYY")
    Next x
End sub
 

Carnage029

XLDnaute Occasionnel
Re : Trier une combobox alimenté par fichier dynamique

J'avais réussi à supprimer les doublons, comme je l'avais dit dans mon autre fil :)
Tu es un fan de mes problèmes :p nan sérieusement merci beaucoup à toi, je teste et j'édit ce message pour dire si le tri fonctionne :)

EDIT : Quand je rajoute la ligne tri(arguments) il me dit erreur, = attendu :(
 
Dernière édition:

Carnage029

XLDnaute Occasionnel
Re : Trier une combobox alimenté par fichier dynamique

Il me sort erreur d'execution 13 : Incompatibilitée de type à la ligne Dte = date...

Juste une remarque, je sais pas si ça change un peu, mais tu as pris le code de l'autre fil, et donc fe ne prend pas la même valeur...

mon code actuel, ou il manque juste le tri (les doublons sont réglés c'est bon est le suivant :

Code:
    Dim MonRepertoire, fa, fe, x As Integer, Dico, Tablo
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dico = CreateObject("Scripting.Dictionary")
    chem = Sheets("system").Range("A25").Value
    MonRepertoire = chem & importcombo.siglecombobox.Text
    x = 1
    For Each fa In fso.GetFolder(MonRepertoire).Files
        lsigle = Len(importcombo.siglecombobox.Text)
        ldevise = Len(importcombo.devisecombobox.Text)
        fe = fa.Name
        fe = Mid(fe, lsigle + ldevise + 5, 6)
        Dico(fe) = fe
        x = x + 1
    Next fa
    Tablo = Dico.keys
    Set Dico = Nothing
    Set fso = Nothing
    For x = LBound(Tablo) To UBound(Tablo)
        importcombo.date1combobox.AddItem Tablo(x)
    Next x
 

tototiti2008

XLDnaute Barbatruc
Re : Trier une combobox alimenté par fichier dynamique

Re,

Je n'ai pas pris le code dans l'autre fil, je l'ai pris sur ton message #3
si fe doit prendre une autre valeur, corrige son calcul, mais n'efface pas toutes les ligne que j'ai ajouté ou on risque de tourner en rond assez longtemps...

Il me sort erreur d'execution 13 : Incompatibilitée de type à la ligne Dte = date..

Que vaut fe quand il plante ?
 

Carnage029

XLDnaute Occasionnel
Re : Trier une combobox alimenté par fichier dynamique

Bon, désolé de ce cafouillage c'est entièrement de ma faute, et je te remercie beaucoup de ton aide :)

La formule à l'air de marcher correctement mis à part que le tri est inversé ("date" la plus ancienne la plus haute)

Je regarde, mais je pense que la modification doit se faire dans la fonction tri..

Encore merci à toi :D

Mon code actuel fonctionne mais à l'envers :

Code:
    importcombo.date1combobox.Clear

    Dim MonRepertoire, fa, fe, x As Integer, Dico, Tablo, Dte As Date
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dico = CreateObject("Scripting.Dictionary")
    chem = Sheets("system").Range("A25").Value
    MonRepertoire = chem & importcombo.siglecombobox.Text
    x = 1
    For Each fa In fso.GetFolder(MonRepertoire).Files
        lsigle = Len(importcombo.siglecombobox.Text)
        ldevise = Len(importcombo.devisecombobox.Text)
        fe = fa.Name
        fe = Mid(fe, lsigle + ldevise + 5, 6)
        Dte = DateSerial(2000 + CInt(Right(fe, 2)), CInt(Mid(fe, 3, 2)), CInt(Left(fe, 2)))
        Dico(CLng(Dte)) = CLng(Dte)
        x = x + 1
    Next fa
    Tablo = Dico.keys
    tri Tablo, LBound(Tablo), UBound(Tablo)
    Set Dico = Nothing
    Set fso = Nothing
    For x = LBound(Tablo) To UBound(Tablo)
        importcombo.date1combobox.AddItem Format(Tablo(x), "DDMMYY")
    Next x
 

tototiti2008

XLDnaute Barbatruc
Re : Trier une combobox alimenté par fichier dynamique

Bonjour Carnage,

Le quick sort décroissant ça doit donner ça :

Code:
Sub tri(a, gauc, droi) ' Quick sort décroissant
    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
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote