Tri des dates dans une combobox

  • Initiateur de la discussion Initiateur de la discussion 13GIBE59
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

13GIBE59

XLDnaute Accro
Bonjour le forum. 🙂

Dans le fichier joint, les deux combobox "Date début" et "date fin" sont alimentées par une liste de dates (colonne A) qui devraient être listées sans doublon (c'est fait) et par ordre 'alphabétique' croissant (?)

Ce n'est pas le cas : les dates apparaissent dans un désordre certain.😡

Quelqu'un peut-il m'aider ? 😕

Merci d'avance. 😉
 

Pièces jointes

Re : Tri des dates dans une combobox

Bonjour

Ci dessous un code pour trier des dates
Principe
La collection permet d'éliminer les doublons en gérant l'erreur
On utilise un tableau contenant la date et une donnée sous la forme année,mois,jour
On utilise ces valeurs pour réaliser le tri.


Code:
Dim err As Byte
Dim Coll As New Collection
Dim table() As String
Dim dl1 As Long ' dernière ligne
Dim Cell As Range
Dim £i As Integer
Dim £j As Integer
Dim £t As Variant
Dim £y As Integer

With Sheets("Feuil2")
dl1 = .Cells(.Rows.Count, 1).End(xlUp).Row
i = 0
ReDim table(1 To dl1, 1 To dl1)
On Error GoTo erreur
For Each Cell In .Range("a2:a" & dl1)
    If IsDate(Cell) Then
    Coll.Add Cell, CStr(Cell)
    If err = False Then
        i = i + 1
        table(i, 1) = Cell
        table(i, 2) = Year(Cell) & Month(cel) & Day(Cell)
    End If
    End If
    err = False
 Next Cell
 On Error GoTo 0
End With
' trier la table par permutation

For £i = 1 To UBound(table, 2)
     For £j = 1 To UBound(table, 2)
        If table(£j, 2) > table(£i, 2) Then
            For £y = 1 To 2
                £t = table(£i, £y)
                table(£i, £y) = table(£j, £y)
                table(£j, £y) = £t
            Next £y
        End If
    Next £j
Next £i
With Me.ComboBoxdebut
    .Clear
    For £i = 1 To UBound(table, 2)
        If table(£i, 1) <> "" Then .AddItem table(£i, 1)
    Next £i
End With
Exit Sub
erreur:
err = True
Resume Next
End Sub

A tester

JP
 
Re : Tri des dates dans une combobox

bonjour,

En modifiant un peu les boucles originales de chargements des combo de Date:
Code:
   Range([A1], [A65536].End(xlUp)).Select
    Set MesTiers = CreateObject("Scripting.Dictionary")
    a = Selection.Value
    For i = 1 To UBound(a)
        If[B] CStr(Cells(i + 1, 1)) <> "" And [/B]Not MesTiers.Exists(CStr(Cells(i + 1, 1))) Then
            MesTiers.Add CStr(Cells(i + 1, 1)), CStr(Cells(i + 1, 1))
        End If
    Next i
    X = MesTiers.keys
    ' Classement des clés
    For n = 0 To UBound(X)
        For m = n + 1 To UBound(X)
           [B] If X(m) = "" Then Exit For
            If DateValue(X(m)) < DateValue(X(n))[/B] Then
                temp = X(m)
                X(m) = X(n)
                X(n) = temp
            End If
        Next m
    Next n

A+
 
Re : Tri des dates dans une combobox

Bonjour,

je me serais contenter de remplacer CStr par CDate,
Code:
    Sheets("Feuil2").Select
    Range([A1], [A65536].End(xlUp)).Select
    Set MesTiers = CreateObject("Scripting.Dictionary")
    a = Selection.Value
    For i = 1 To UBound(a)
        If Not MesTiers.Exists([B]CDate[/B](Cells(i + 1, 1))) Then
            MesTiers.Add [B]CDate[/B](Cells(i + 1, 1)), [B]CDate[/B](Cells(i + 1, 1))
        End If
    Next i
 
Re : Tri des dates dans une combobox

Bonsoir Lii, Hasco, JP14.🙂

Désolé pour la réponse tardive. 🙁

Merci à vous trois de vous être penchés sur mon problème. Tout marche bien, et je n'ai que l'embarras du choix. Comme d'habitude, je vais aller au plus simple, pour soulager mon demi-neurone. 😉

A +
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
40
Affichages
2 K
Retour