Trier des données par date la plus récente sous VBA

**FaruSZ** · 06/06/2020, 11h24

Bonjour,
J'ai une base de données, j'ai une liste de formations avec la date d'obtention que je dois afficher dans une listbox (dans un userform).
Mes formations sont arrangées dans ma feuilles Excel comme suit:

Colonne A
Formation:	002	003	004	002	001	003	005	006	002	001
Date d'obtention :	05/11/2012	05/11/2018	05/11/2019	27/03/2017	27/03/2018	27/03/2020	20/09/2015	20/09/2017	20/09/2018	16/11/2010

Je veux sur ma listbox que l'affichage se fait sans doublons en affichant la date la plus recente pour chaque formation comme suit:

Formation	Date d'obtention
001	27/03/2018
002	20/09/2018
003	27/03/2020
004	05/11/2019
005	20/09/2015
006	20/09/2017

Je suis nocive dans VBA et je ne sais pas comment procéder, merci pour votre aide.

Invité · 06/06/2020, 14h25

Bonjour,

J'ai un programme VBA qui permet de :

Trier une clef primaire dans un ordre croissant ou décroissant en fonction d'un deuxième champ.

Au final on ne garde qu'un seul fois la clef primaire. En fonction du tri croissant ou décroissant , le second champ est concaténé . Si croissant le second champ affiche a l'évènement le plus petit en premier, si décroissant l'évènement le plus grand en premier.

Chaine de taille variable avec séparateur unique. On récupère le premier élément avant le premier séparateur. Tout le reste de la chaine peut être éjecté.

Plus de précision par MP pour le code VBA et le fichier Excel qui va bien

**Menhir** · 06/06/2020, 15h38

Envoyé par FaruSZ

Mes formations sont arrangées dans ma feuilles Excel comme suit:

Colonne A
Formation:	002	003	004	002	001	003	005	006	002	001
Date d'obtention :	05/11/2012	05/11/2018	05/11/2019	27/03/2017	27/03/2018	27/03/2020	20/09/2015	20/09/2017	20/09/2018	16/11/2010

Je veux sur ma listbox que l'affichage se fait doublons en affichant la date la plus recente pour chaque formation comme suit:

Formation	Date d'obtention
001	27/03/2018
002	20/09/2018
003	27/03/2020
004	05/11/2019
005	20/09/2015
006	20/09/2017

La première chose à faire est de transposer tes données pour mettre les champs par colonne parce que quasiment toutes les méthode de tri, de filtre et de suppression de doublons fonctionnent ainsi.

Il sera plus rapide de le faire à la main (un Ctrl+C suivi d'un collage spécial avec Transposée) que de le faire en VBA.

**FaruSZ** · 06/06/2020, 16h00

Envoyé par Menhir

La première chose à faire est de transposer tes données pour mettre les champs par colonne parce que quasiment toutes les méthode de tri, de filtre et de suppression de doublons fonctionnent ainsi.

Il sera plus rapide de le faire à la main (un Ctrl+C suivi d'un collage spécial avec Transposée) que de le faire en VBA.

je vux bien vous envoyer mon fichie rpour mieux comprendre mon but mais je narrive pas a le charger sur le forum.

Invité · 06/06/2020, 16h12

Envoyé par FaruSZ

Une solution possible :

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
 
Option Explicit
 
Public Formations() As Variant
 
Sub TestChargerLaListeDesFormations()
 
    Erase Formations
 
    ChargerLaListeDesFormations ActiveSheet.Range("B1:K1")
 
    With UserForm1
         .ListBox1.Column = Formations
         .Show
    End With
 
 
End Sub
 
 
Sub ChargerLaListeDesFormations(ByVal AireFormations As Range)
 
Dim ListeFormations As Object
Dim CelluleFormation As Range
Dim ListeCles As Variant, ListeElements As Variant
Dim I As Integer, J As Integer
Dim Temp1 As Variant, Temp2 As Variant
 
 
    Set ListeFormations = CreateObject("Scripting.Dictionary")
 
    For Each CelluleFormation In AireFormations
        If Not ListeFormations.Exists(CStr(CelluleFormation)) Then
           ListeFormations.Add CStr(CelluleFormation), CelluleFormation.Offset(1, 0)
        End If
    Next CelluleFormation
 
    ListeCles = ListeFormations.keys
 
    ' Tri des formations par ordre alphabétique
    '------------------------------------------
    For I = LBound(ListeCles) To UBound(ListeCles) - 1
        For J = I + 1 To UBound(ListeCles)
            If ListeCles(I) > ListeCles(J) Then
               Temp1 = ListeCles(I)
               ListeCles(I) = ListeCles(J)
               ListeCles(J) = Temp1
             End If
        Next J
    Next I
 
    For I = LBound(ListeCles) To UBound(ListeCles)
        ReDim Preserve Formations(1, I)
        Formations(0, I) = ListeCles(I)
        Formations(1, I) = 0
    Next I
 
    ' Chargement de la matrice fes formations
    '----------------------------------------
    For I = LBound(Formations, 2) To UBound(Formations, 2)
        For Each CelluleFormation In AireFormations
            If CStr(CelluleFormation.Value) = CStr(Formations(0, I)) Then
              If CDate(CelluleFormation.Offset(1, 0)) > CDate(Formations(1, I)) Then
                 Formations(1, I) = CelluleFormation.Offset(1, 0)
              End If
            End If
        Next CelluleFormation
    Next I
 
   ' For I = LBound(Formations, 2) To UBound(Formations, 2)
   '     Debug.Print Formations(0, I) & " : " & CDate(Formations(1, I))
   ' Next I
 
    Set ListeFormations = Nothing
 
End Sub

Pièce jointe 570776

**FaruSZ** · 06/06/2020, 20h29

Envoyé par Eric KERGRESSE

Une solution possible :

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
 
Option Explicit
 
Public Formations() As Variant
 
Sub TestChargerLaListeDesFormations()
 
    Erase Formations
 
    ChargerLaListeDesFormations ActiveSheet.Range("B1:K1")
 
    With UserForm1
         .ListBox1.Column = Formations
         .Show
    End With
 
 
End Sub
 
 
Sub ChargerLaListeDesFormations(ByVal AireFormations As Range)
 
Dim ListeFormations As Object
Dim CelluleFormation As Range
Dim ListeCles As Variant, ListeElements As Variant
Dim I As Integer, J As Integer
Dim Temp1 As Variant, Temp2 As Variant
 
 
    Set ListeFormations = CreateObject("Scripting.Dictionary")
 
    For Each CelluleFormation In AireFormations
        If Not ListeFormations.Exists(CStr(CelluleFormation)) Then
           ListeFormations.Add CStr(CelluleFormation), CelluleFormation.Offset(1, 0)
        End If
    Next CelluleFormation
 
    ListeCles = ListeFormations.keys
 
    ' Tri des formations par ordre alphabétique
    '------------------------------------------
    For I = LBound(ListeCles) To UBound(ListeCles) - 1
        For J = I + 1 To UBound(ListeCles)
            If ListeCles(I) > ListeCles(J) Then
               Temp1 = ListeCles(I)
               ListeCles(I) = ListeCles(J)
               ListeCles(J) = Temp1
             End If
        Next J
    Next I
 
    For I = LBound(ListeCles) To UBound(ListeCles)
        ReDim Preserve Formations(1, I)
        Formations(0, I) = ListeCles(I)
        Formations(1, I) = 0
    Next I
 
    ' Chargement de la matrice fes formations
    '----------------------------------------
    For I = LBound(Formations, 2) To UBound(Formations, 2)
        For Each CelluleFormation In AireFormations
            If CStr(CelluleFormation.Value) = CStr(Formations(0, I)) Then
              If CDate(CelluleFormation.Offset(1, 0)) > CDate(Formations(1, I)) Then
                 Formations(1, I) = CelluleFormation.Offset(1, 0)
              End If
            End If
        Next CelluleFormation
    Next I
 
   ' For I = LBound(Formations, 2) To UBound(Formations, 2)
   '     Debug.Print Formations(0, I) & " : " & CDate(Formations(1, I))
   ' Next I
 
    Set ListeFormations = Nothing
 
End Sub

Pièce jointe 570776

Merci pour votre aide, jai placé le code dans un module quand jai ouvert le userform jais que la colonne 1 qui s'affiche comme vous pouvez les voir:

Invité · 07/06/2020, 04h22

Envoyé par FaruSZ

Je ne vois que ce que je vous ai envoyé. Il vous faut régler le nombre de colonnes de votre ListBox (ColumnCount) comme dans ce vidage d'écran et définir les largeurs de chacune (ColumnWidths).

Pièce jointe 570918

Invité · 06/06/2020, 17h06

Envoyé par Menhir

La première chose à faire est de transposer tes données pour mettre les champs par colonne parce que quasiment toutes les méthode de tri, de filtre et de suppression de doublons fonctionnent ainsi.

Il sera plus rapide de le faire à la main (un Ctrl+C suivi d'un collage spécial avec Transposée) que de le faire en VBA.

Le code vba que j'ai a proposé fait déjà ce boulot.

1) faire un tri simple via exemple (croissant ou decroissant)

2) en cliquant sur un bouton on récupérer une transposée

**FaruSZ** · 07/06/2020, 16h06

Envoyé par tanaka59

Le code vba que j'ai a proposé fait déjà ce boulot.

1) faire un tri simple via exemple (croissant ou decroissant)

2) en cliquant sur un bouton on récupérer une transposée

Invité · 07/06/2020, 17h58

Bonjour,

Envoyé par Menhir

La première chose à faire est de transposer tes données pour mettre les champs par colonne parce que quasiment toutes les méthode de tri, de filtre et de suppression de doublons fonctionnent ainsi.

Il sera plus rapide de le faire à la main (un Ctrl+C suivi d'un collage spécial avec Transposée) que de le faire en VBA.

Je vais reprendre un fichier exemple pour illustrer mon idée :

Trier des données par date la plus récente sous VBA

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager