trier une listbox

trier une listbox - VB/VBA/VBS - Programmation

Marsh Posté le 02-08-2006 à 14:57:01    

Bonjour à tous, ca faisait longpts ke je n'etais pas venu vous déranger !
 
alors voia lje crée une listbox que j'alimente avec une plage de donnée sur mon fichier Excel avec des dates.
Je vire les redondances dans l'alimentation
 
Mais comment peut on trier cette listbox pour qu'a l'affichage tout soit dans l'ordre ?
 
 
car j'ai deja cherché ailleurs mais soit il n'y avait pas de réponse soit les fichiers que j'ai téléchargé avec les soi disantes réponses etaient illisible
 
Voila sinon l'alimentation de ma listbox :  
 
Dim Cell3 As Range, Valeur3 As Range
Dim Unique3 As New Collection
Dim i As Byte
On Error Resume Next
For Each Cell3 In Range("enr_incidents!Date" )
    Unique3.Add Cell3, CStr(Cell3)
Next Cell3
On Error GoTo 0
For Each Valeur3 In Unique3
    ListDateDebut.AddItem Valeur3
    ListDateFin.AddItem Valeur3
Next Valeur3
 
 
Merci à tous !

Reply

Marsh Posté le 02-08-2006 à 14:57:01   

Reply

Marsh Posté le 02-08-2006 à 15:00:42    

Qu'appelles tu dans l'ordre ? ordre alphabétique ?

Reply

Marsh Posté le 02-08-2006 à 15:06:21    

ma listbox est rempli par une plage de données rempli par des dates
 
j'affiche ensuite cette listbox dans un userform, et j'aimerai que les dates apparaissent dans l'ordre

Reply

Marsh Posté le 02-08-2006 à 15:10:11    

GillooZ a écrit :

ma listbox est rempli par une plage de données rempli par des dates
 
j'affiche ensuite cette listbox dans un userform, et j'aimerai que les dates apparaissent dans l'ordre


tri à bulles (comment ca j'ai déjà proposé ca ce matin à quelqu'un d'autre.... :p

Reply

Marsh Posté le 02-08-2006 à 15:16:00    

ya un départ de code pour ca dans le post ou tu as repondu ca ?

Reply

Marsh Posté le 02-08-2006 à 15:17:18    

Reply

Marsh Posté le 02-08-2006 à 15:19:58    

ok merci je vais partir de la :)

Reply

Marsh Posté le 04-08-2006 à 10:49:26    

Jai modifié le code du tri pour l'adapter à mon code, sachant que je cherche à trier une listbox contenant des dates.
 
mais il me fait une erreur de compatibilité  
Voila mon code :
Dim k As Integer
Dim x As Date
Randomize
For i = 1 To ListDateDebut.ListCount - 1
    j = i
    For k = j + 1 To ListDateDebut.ListCount - 1
        If ListDateDebut.Column(0, k) <= ListDateDebut.Column(0, j) Then
            j = k
        End If
    Next k
    If i <> j Then
        x = ListDateDebut.Column(0, j)
        ListDateDebut.Column(0, j) = ListDateDebut.Column(0, i)
        ListDateDebut.Column(0, i) = x
    End If
Next i

Reply

Marsh Posté le 04-08-2006 à 10:52:57    

A quelle ligne te sort-il l'incompatibilité stp ?

Reply

Marsh Posté le 04-08-2006 à 11:29:29    

il ne me met pas de ligne, il me met l'erreur en msgbox seulement

Reply

Marsh Posté le 04-08-2006 à 11:29:29   

Reply

Marsh Posté le 04-08-2006 à 11:30:13    

je vais balancer tout le code de mon initialisation peut etrre que cela vous aidera (pour m'aider lol)
 
Private Sub UserForm_Initialize()
ListCli.MultiSelect = fmMultiSelectExtended
'initialisation de la multi selection de la listbox client
OptionButtonPPM.Value = False
OptionButtonPPDM.Value = False
On Error Resume Next
'mise a vide des boutons indicateurs PPM et PPDM
Dim Cell As Range, Valeur As Range
Dim Unique As New Collection
Dim j As Byte
On Error Resume Next
For Each Cell In Range("enr_incidents!Customers" )
    Unique.Add Cell, CStr(Cell)
Next Cell
On Error GoTo 0
For Each Valeur In Unique
    ListCli.AddItem Valeur
Next Valeur
'alimentation de la listbox client en enlevant les redondances
ListBoxResp.MultiSelect = fmMultiSelectExtended
'initialisation de la multi selection de la listbox client
Dim Cell2 As Range, Valeur2 As Range
Dim Unique2 As New Collection
For Each Cell2 In Range("enr_incidents!ResponsabiliteZ" )
    Unique2.Add Cell2, CStr(Cell2)
Next Cell2
On Error GoTo 0
For Each Valeur2 In Unique2
    ListBoxResp.AddItem Valeur2
Next Valeur2
'alimentation de la listbox responsabilité en enlevant les redondances
Dim Cell3 As Range, Valeur3 As Range
Dim Unique3 As New Collection
Dim i As Byte
On Error Resume Next
For Each Cell3 In Range("enr_incidents!Date" )
    Unique3.Add Cell3, CStr(Cell3)
Next Cell3
On Error GoTo 0
For Each Valeur3 In Unique3
    ListDateDebut.AddItem Valeur3
    ListDateFin.AddItem Valeur3
Next Valeur3
 
Dim k As Integer
Dim x As Date
Randomize
For i = 1 To ListDateDebut.ListCount - 1
    j = i
    For k = j + 1 To ListDateDebut.ListCount - 1
        If ListDateDebut.Column(0, k) <= ListDateDebut.Column(0, j) Then
            j = k
        End If
    Next k
    If i <> j Then
        x = ListDateDebut.Column(0, j)
        ListDateDebut.Column(0, j) = ListDateDebut.Column(0, i)
        ListDateDebut.Column(0, i) = x
    End If
Next i
 
 
ListBoxCost.MultiSelect = fmMultiSelectExtended
'initialise tous les objets contenus dans le UserForm concernant les indicateurs
End Sub

Reply

Marsh Posté le 07-08-2006 à 09:35:27    

personne la ?
 
up du lundi !

Reply

Marsh Posté le 07-08-2006 à 23:03:54    

A Adapter


Sub AjoutNomListBox(Nom As String, LB As MSForms.ListBox)
Dim i As Integer
  For i = 0 To LB.ListCount - 1
    If LB.List(i) > Nom Then Exit For
  Next
  LB.AddItem Nom, i
End Sub
 
Sub InitLBUsrFrm()
    With UserForm1
        .ListBox1.Clear
        AjoutNomListBox "Z", .ListBox1
        AjoutNomListBox "Y", .ListBox1
        AjoutNomListBox "X", .ListBox1
        AjoutNomListBox "W", .ListBox1
        AjoutNomListBox "V", .ListBox1
        .Show
    End With
End Sub


Message édité par kiki29 le 07-08-2006 à 23:26:08
Reply

Marsh Posté le 08-08-2006 à 08:44:13    

erf en fait le mec pour qui je programme ca m'a dit : on s'en fou des dates de la plage, tu me mets toutes les dates du calendriers trié.
ya pas une fonction qui permet d'alimenter directement une listbox avec ca ?

Reply

Marsh Posté le 08-08-2006 à 11:51:21    

Non mais en mettant toutes les dates du millenaire cela devrait laisser de la marge

Reply

Marsh Posté le 08-08-2006 à 12:19:57    

je vois pas le rapport de ta reponse kiki

Reply

Marsh Posté le 08-08-2006 à 12:56:16    

j'ai adapté ton algo kiki :  
 
Sub AjoutDate(DateLue As Date, LB As ListBox)
Dim i As Integer
For i = 1 to LB.ListCount - 1  
    If LB.List(i) > DateLue Then
        Exit For
    End If
Next i
 
End Sub
 
 
et dans ma fonction d'alimentation, je vire les doublons à l'aide de :
 
Dim Cell3 As Range, Valeur3 As Range
Dim Unique3 As New Collection
Dim i As Byte
On Error Resume Next
For Each Cell3 In Range("enr_incidents!Date" )
    Unique3.Add Cell3, CStr(Cell3)
Next Cell3
On Error GoTo 0
For Each Valeur3 In Unique3
    AjoutDate Valeur3, ListeDateDebut
    ListDateFin.AddItem Valeur3
Next Valeur3
 
 
et la j'ai une erreur : type d'argument ByRef incompatible  
 
avec le valeur3 surligné

Reply

Marsh Posté le 08-08-2006 à 15:08:25    

j'ai vu qu'il existait une propriete Sort, peut on l'utiliser pour trier des dates dans une listebox ?

Reply

Marsh Posté le 08-08-2006 à 18:41:24    

Essaie mais tu verras que si l'ordre julien des dates doit être conservé  cela fout le bazar dans ta liste
 
En fait quand j'ai à trier des dates je garde dans une colonne adjacente invisible ou ailleurs
dans un tableau etc une référence sur la laquelle je fait le tri
dans disons cette référence cachée les dates sont par exemple sous la forme Quantième de l'année Année ou AAAAmmJJ avec 4 digits pour l'année 2 pour le mois et 2 pour les jours.
Soit par exemple pour aujourd'hui en julien 2202006 ou en AAAAmmJJ 20060808
 
pour le quantieme de l'année  
 
Private Function JourJulien(Optional Valeur As Date = 0) As Integer
  If Valeur <= 0 Then Valeur = Date
  JourJulien = DatePart("y", Valeur)
End Function


Message édité par kiki29 le 08-08-2006 à 19:03:03
Reply

Marsh Posté le 08-08-2006 à 19:43:10    

A Adapter : Une année complète ... pour alimentation


Option Explicit
 
Sub tst()
    Cells.Clear
    AnnéeEntiere
End Sub
 
Private Sub AnnéeEntiere()
Dim Mois As Integer, Jour As Integer
Dim i As Integer
    i = 1
    For Mois = 1 To 12
        For Jour = 1 To 31
           If IsDate(Jour & "/" & Mois & "/" & Year(Now)) Then
                Cells(i, 1) = Format(CDate(Jour & "/" & Mois & "/" & Year(Now)), "dd/mm/yyyy" )
                Cells(i, 2) = JourJulien(Cells(i, 1))
                Cells(i, 3) = CLng(Cells(i, 1))
                i = i + 1
           End If
        Next
    Next
End Sub
 
Private Function JourJulien(Optional Valeur As Date = 0) As Integer
  If Valeur <= 0 Then Valeur = Date
  JourJulien = DatePart("y", Valeur)
End Function


Message édité par kiki29 le 09-08-2006 à 06:34:29
Reply

Marsh Posté le 08-08-2006 à 20:14:53    

Apres un test rapide cela semble fonctionner correctement


Sub AjoutDateListBox(d As Date, LB As MSForms.ListBox)
Dim i As Integer
  For i = 0 To LB.ListCount - 1
    If LB.List(i) > d Then Exit For
  Next
  LB.AddItem d, i
End Sub
 
Private Sub AjoutAnnéeEntiere()
Dim Mois As Integer, Jour As Integer
Dim d As Date
    ' ************************* en vrac pour test
    For Mois = 12 To 1 Step -1
        For Jour = 31 To 1 Step -1
           If IsDate(Jour & "/" & Mois & "/" & Year(Now)) Then
                d = Format(CDate(Jour & "/" & Mois & "/" & Year(Now)), "dd/mm/yyyy" )
                AjoutDateListBox d, UserForm1.ListBox1
           End If
        Next
    Next
End Sub


Message édité par kiki29 le 09-08-2006 à 06:35:26
Reply

Marsh Posté le 09-08-2006 à 08:57:46    

merci beaucoup à tous en tout cas ca va bien m'aider et merci a toi kiki pour tes algos ^^
 
bonne journée à tous

Reply

Marsh Posté le 09-08-2006 à 13:32:50    

j'ai bien mis la fonction AjoutDateListBox et j'ai rajouter le code de AjoutAnneeEntiere dans ma partie initialize mais quand je lance mon userform la listbox est vide :'(

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed