Tri par ordre croissant date listbox

[rkan]

Bonjour,

Avant de post j'ai fait un petit tour sur le forum sans succès,

Donc pour faire simple voilà à quoi ressemble le code avec lequel je récupère les dates de mon tableau sous forme de listbox :

Private Sub UserForm_Initialize()
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim i As Integer

   
    i = Range("H65536").End(xlUp).Row
    
    On Error Resume Next

    For Each Cell In Range("H5:H" & i)
        
        If CDate(Cell.Value) <> "" Then
        Unique.Add Cell, CStr(Cell)
        End If
        
    Next Cell
    
    On Error GoTo 0
    
    For Each Valeur In Unique
        If IsDate(Valeur.Value) Then
            Me.ListBox1.AddItem Valeur
        End If
        
    Next Valeur
 
End Sub

J'utilise tout ça dans un USERFORM, ça fonctionne comme il faut sauf que je ne vois pas comment modifier le code pour récupérer les dates par ordre croissant sans passer par un filtre sur mon tableau.

Si quelqu'un à une idée ça me sauverait ma journée

 

[PrinceCorwin]

Re : Tri par ordre croissant date listbox

Bonjour,

Faire le tri :

Public 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

Pour le remplissage de ma liste sans doublon, j'utilise plutot un Dictionaire
Apparemment c'est beaucoup plus rapide que l'objet Collection.

Set t = CreateObject("Scripting.Dictionary")
For Each c In f.Range("E2:E10100")
    If c.Offset(, 1) = "N" Then
        If c.Value <> "" Then
            If Not t.Exists(c.Value) Then
                t.Add c.Value, c.Value
            End If
        End If
    End If
Next c
If t.Count > 0 Then
    LISTE = t.items
    Call tri(LISTE, LBound(LISTE), UBound(LISTE))
    Me.REFCMD.List = LISTE
End If

Bonne continuation

 

[rkan]

Re : Tri par ordre croissant date listbox

voilà j'ai essayé d'adapter ton code par rapport à mon bidule : ça donne :

Private Sub UserForm_Initialize()
   Set t = CreateObject("Scripting.Dictionary")
   Dim i As Integer
   Dim cell As Range
   
   
    i = Range("H65536").End(xlUp).Row
   
    On Error Resume Next
   
        For Each cell In f.Range("H5:H" & i)
            If cell.Offset(, 1) = "N" Then
                If cell.Value <> "" Then
                    If Not t.Exists(cell.Value) Then
                        t.Add cell.Value, cell.Value
                    End If
                End If
            End If
        Next cell
        
If t.Count > 0 Then
    LISTE = t.items
    Call tri(LISTE, LBound(LISTE), UBound(LISTE))
    Me.REFCMD.List = LISTE
End If
    
End Sub

Le problème est que "REFCMD" n'est pas reconnue par VBA et il me renvoie l'erreur membre de méthode introuvable ou inconnu.

 

[PrinceCorwin]

Re : Tri par ordre croissant date listbox

Bonjour,

A la place de

Me.REFCMD.List = LISTE

note

Me.ListBox1.List = LISTE

Bonne journée

 

[rkan]

Re : Tri par ordre croissant date listbox

Bonjour,

Désolé pour la réponse tardive j'ai été un peu bousculé ces dernier jours,

j'ai bien remplacé REFCMD par Listbox1, il n'y a plus de message d'erreur mais désormais la listbox ne retourne plus de resultat...

j'ai continué de mon côté à chercher une solution et finalement avec le code suivant j'ai bien un listbox de date par ordre croissant :

Private Sub UserForm_Initialize()
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim i As Integer
    Dim x As Integer
    Dim y As Integer
    
    
With ListBox1
    For x = 0 To .ListCount - 1
        For y = 0 To .ListCount - 1
            If .List(x) < .List(y) Then
                temp = .List(x)
                .List(x) = .List(y)
                .List(y) = temp
            End If
        Next y
    Next x
End With

'Récupère la derniere ligne non vide dans la colonne H
    Sheets("SYNTHESE").Select
    i = Range("H65536").End(xlUp).Row
    
    On Error Resume Next

    'boucle sur les cellules de la colonne H
    For Each Cell In Range("H5:H" & i)

        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        Unique.Add Cell, CStr(Cell)
    Next Cell
    On Error GoTo 0
    
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        If IsDate(Valeur.Value) And Not IsNull(Valeur.Value) Then
            Me.ListBox1.AddItem Valeur
        
        End If
        
    Next Valeur
       
End Sub

Merci encore pour la réponse.

 

[herve62]

Re : Tri par ordre croissant date listbox

Bonjour
Je me permet de joindre une fonction simple que j'ai utilisé recemment dans une appli
-Tri de la liste et saisie intuitive dans la box

Sub tri_Nom(Nom_P)
n = Nom_P.ListCount
ReDim matable(n)
For i = 0 To n - 1
    k1 = Nom_P.List(i)
    If k1 > maxi Then
        matable(i) = k1
        maxi = k1
    Else
        k = 0
        While k1 > matable(k)
            k = k + 1
                    Wend
        'décallage
        For z = i To k Step -1
            matable(z + 1) = matable(z)
        Next
        matable(k) = k1
        Application.StatusBar = i
   End If
Next
Nom_P.List() = matable
End Sub

Nom_P est ma combobox
J'ai mis cette Sub dans un module et je l'appelle depuis l'USF initialize après avoir "alimenté" cette box
Si cela peut donner une idée !!!