Discussion :

[mandrake57]

Bonsoir à tous, je cherche à réaliser dans une USF un tri sans doublon des mois et des années à partir d'un listing de dates sur une autre feuille.

Au départ je voulais sur cette USF une combobox qui m'indique la période sous cette forme mmmm/aaaa, mais je crois que cela ne marche pas pour le tri...

Alors je suis parti sur l'idée que l'utilisateur ait 2 combobox, l'une pour les mois et l'autre pour les années. J'ai réussi mais en laissant les mois sous forme de chiffre (alors que je les voudrais en lettres) et je ne sais pas si mon code est "juste"...

Quelqu'un peut-il me dire si il est possible de le simplifier?

Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
Public cbox As String 'définition de la variable cbox (combobox) comme variable fixe "public"
Public dl As Long 'définition de la variable dl (dernière ligne) comme variable entier long "public"
 
Private Sub bouton_fermeture_Click()
 
choix_periode.Hide 'fermeture de la fiche de choix de la période pour le listing
End Sub
 
Private Sub UserForm_Activate()
 
Application.ScreenUpdating = False 'mise à jour de l'écran bloquée
With Sheets("Base")
    dl = .Range("A" & .Rows.Count).End(xlUp).Row 'définition de la valeur de la dernière ligne (variable dl)
    cbox = "box_annee"
    creer_liste_annee_sansdoublons .Range("A4:A" & dl) 'définition de la plage concernant les demandeurs
    cbox = "box_mois"
    creer_liste_mois_sansdoublons .Range("A4:A" & dl) 'définition de la plage concernant les demandeurs
End With
End Sub
 
Sub creer_liste_annee_sansdoublons(Plage As Range)
Dim Cell As Range, cible
Dim Un As Collection
Dim ssdoublon(), valeur As Long, i As Long
 
Set Un = New Collection
On Error Resume Next
For Each Cell In Plage
    If Cell <> "" Then Un.Add Year(Cell), CStr(Year(Cell))
Next Cell
On Error GoTo 0
For i = 1 To Un.Count
    ReDim Preserve ssdoublon(i - 1)
    ssdoublon(i - 1) = Un.Item(i)
Next i
Do 'définition du système de tri croissant
valeur = 0
For i = UBound(ssdoublon) - 1 To 0 Step -1
    If ssdoublon(i) > ssdoublon(i + 1) Then
        cible = ssdoublon(i)
        ssdoublon(i) = ssdoublon(i + 1)
        ssdoublon(i + 1) = cible
        valeur = 1
    End If
Next i
Loop While valeur = 1
Me.Controls(cbox).List = ssdoublon()
Set Un = Nothing
End Sub
 
Sub creer_liste_mois_sansdoublons(Plage As Range)
Dim Cell As Range, cible
Dim Un As Collection
Dim ssdoublon(), valeur As Long, i As Long
 
Set Un = New Collection
On Error Resume Next
For Each Cell In Plage
    If Cell <> "" Then Un.Add Month(Cell), CStr(Month(Cell))
Next Cell
On Error GoTo 0
For i = 1 To Un.Count
    ReDim Preserve ssdoublon(i - 1)
    ssdoublon(i - 1) = Un.Item(i)
Next i
Do 'définition du système de tri croissant
valeur = 0
For i = UBound(ssdoublon) - 1 To 0 Step -1
    If ssdoublon(i) > ssdoublon(i + 1) Then
        cible = ssdoublon(i)
        ssdoublon(i) = ssdoublon(i + 1)
        ssdoublon(i + 1) = cible
        valeur = 1
    End If
Next i
Loop While valeur = 1
Me.Controls(cbox).List = ssdoublon()
Set Un = Nothing
End Sub

Merci pour le coup de main.

Ou sinon :

Je vais poser la question différemment, est-il possible de réaliser un tri sans doublon d'une plage de cellule ne comportant que des dates au format jj/mm/aaaa et d'incorporer cette liste trié dans une combobox ou les dates serait au format mmmm/aaaa?

[AlainTech]

Bonjour,

Tu peux utiliser une collection que tu alimentes par une boucle.
Il faut mettre en place une gestion d'erreur pour éviter les messages intempestifs lors de l'ajout d'un élément existant.

Il reste alors à alimenter la Combo avec le contenu de la collection.

[mandrake57]

J'avous que je ne maîtrise pas les collections, j'ai du mal à comprendre ce que tu me présentes comme solution.

[homerlehamster]

Salut,

Je pense que AlainTech veut parler de ça :

Déclaration :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
    Dim Cell As Range 'sert à alimenter la collection "Unique"
    Dim Unique As New Collection  'collection contenant l'ensemble des items (sans doublons)
    Dim Valeur As Range 'sert à alimenter la collection "Unique"

alimenter la combobox :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
                            On Error Resume Next
                            'boucle sur les cellules de la colonne B
                            For Each Cell In Workbooks(cntProbFile).Worksheets(cntFProbExp).Range("B1:B" & VarLastLineProbLocal)
                            '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
                                frmPrgInsert.CboPgm.AddItem Valeur
                            Next Valeur