VBA - Variable Tableau & Trie Date

**Ducrocq Thomas** · 02/06/2018, 02h48

Bonjour,

cela fait 2 jour que je sèche complétement devant mon PC a parcourir moultes forums sans trouver la réponse qui convient a mon application.
J'ai un Classeur qui contient en gros 3000 lignes (commande d'article unique) pour 150 colonnes (références dates des livraisons sur tel ou tel sites ... ... .. )
Afin d'aller très vite je génère une variable tableau, je fais mes calcul et je recrache les infos via VBA...

bien sur l'idée est de trier les dates par article et non plus par commande
DATA brut
Commande // Article // Désignation // Site A Qty // Site A Livraison // Site B Qty // Site B Livraison ...
1 //9999999999 // Clavier de PC // 2 // 22/06/2018 //0 //
34 //9999999999 // Clavier de PC // 2 // 25/08/2018 //0 //
6666 //9999999999 // Clavier de PC // 9 // 16/06/2018 //15 //16/06/2018

dois devenir
Article // Désignation // Site A Livraison 1
9999999999 // Clavier de PC // 16/06/2018 puis 22/06/2018 puis 25/08/2018

J'arrive presque à généré ma variable tableau avec les données, a vérifier si la date de la commande 25 exite ou non dans mon tableau et a la rajouter si besoin ... puis j'arrive presque a ordonnancer mes dates...

il ya trop de lignes et de colonnes pour passer par une formatage de la colonne = "@" et repasser par un formatage a la fin "dd/mm/yyyy"

Bien sur tous mes soucis viennent du fait que mes dates sont dans Excel au format FR JJ/mm/YYYY et que le VBA les réinterpréte en format 'DATE US ; MM/DD/YYYY => du coup la livraison attendue pour le premier decembre est planifier pour le 12 janvier ... les réceptionnistes font attendre longtemps

Pour l'exemple j'ai simplifié la recherche de la date a une cellule d'une feuille de test (Onglet 8 : TEST)

Si quelqu’un avait l'amabilité de me débloquer....

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
 
Dim Table_Data() As Date
    Dim Date_connue As Integer
    Dim i, j, Compteur_de_Date, Nombre_de_Ligne As Integer
    Dim Date_Temporaire As Date
 
    Dim Table_Result() As Date
 
    Erase Table_Result
    Erase Table_Data
    Date_connue = 0
 'A
 '---------------- Uniquement pour le test----------------------------
   Set Ws_Departement = Sheets(8)
 
    Nombre_de_Ligne = Ws_Departement.Range("A65536").End(xlUp).Row
 
    ReDim Table_Data(1 To Nombre_de_Ligne)
 
    'Remplissage du tableau qui va être testé
    For Compteur_de_Date = 1 To UBound(Table_Data)
        Table_Data(Compteur_de_Date) = CDate(Ws_Departement.Cells(Compteur_de_Date, 1))
    Next Compteur_de_Date
 
  '-------------------------------------------------------------------
 
 
'B
'============================== CODE a GARDER FONCTION TEST  ==============================
 
    'On test tout le tableau DAte (Table_Data)
    'a) si on trouve la nouvelle date alors la variable Date_connue passe 1 => on s'arret la
    '(dans le TEST nouvelle date = CDate(Ws_Departement.Cells(6, 4))
    '(dans la macro nouvelle date = il s'agira de la nouvelle valeur issue TABLE_DATA...)
    '
    'b )Si la variable Date_connue reste = 0 => on ne connait pas la date et on l'ajoute a la fin de la liste
 
 
    For Compteur_de_Date = 1 To UBound(Table_Data)
        If Table_Data(Compteur_de_Date) = CDate(Ws_Departement.Cells(6, 4)) Then
            Date_connue = 1
            Exit For
        End If
    Next Compteur_de_Date
 
'C
'============================== CODE a GARDER FONCTION AJOUT ==============================
    'b )Si la variable Date_connue reste = 0 => on ne connait pas la date et on l'ajoute a la fin de la liste
    '(dans le TEST on ajoute la nouvelle date = CDate(Ws_Departement.Cells(6, 4))
    '(dans la macro nouvelle date = il s'agira de la nouvelle valeur issue Table_DATA...)
 
    If Date_connue = 0 Then
        Compteur_de_Date = UBound(Table_Data) + 1
        ReDim Preserve Table_Data(1 To Compteur_de_Date)
        Table_Data(Compteur_de_Date) = CDate(Ws_Departement.Cells(6, 4))
    End If
 
'============================== Affichage de TEST Partie B&C =================
    'For Compteur_de_Date = 1 To UBound(Table_Data)
    'Debug.Print Table_Data(Compteur_de_Date)
    'Next
'==================================================================
 
'D
'============================== CODE a GARDER Fonction TRIER ==============================
 
'On regarde si la premiere date du Tableau est superieure a la seconde
'si oui
'on stocke la 1 e valeur dans la variable Date_Temporaire
'on stocke la 2e valeur a la place de la 1er valeur
'on stocke la Date_Temporaire a la place de la 2e Valeur
' et ainsi de suite jusqu'a un tour de complet
'si non on passe au test de la 2e valeur avec la 3e valeur ...
 
For i = 1 To UBound(Table_Data)
    For Compteur_de_Date = 1 To UBound(Table_Data) - 1
    If CDate(Table_Data(Compteur_de_Date)) > CDate(Table_Data(Compteur_de_Date + 1)) Then
        Date_Temporaire = CDate(Table_Data(Compteur_de_Date))
        Table_Data(Compteur_de_Date) = CDate(Table_Data(Compteur_de_Date + 1))
        Table_Data(Compteur_de_Date + 1) = CDate(Date_Temporaire)
    End If
    Next Compteur_de_Date
Next i
 
 
'Uniquement pour le test :
'Uniquement pour le test : ca permet d'avoir une liste de plus en plus longue pour nos essais :)
Range(Ws_Departement.Cells(1, 1), Ws_Departement.Cells(UBound(Table_Data), 1)) = Application.WorksheetFunction.Transpose(Table_Data)
 
'E
'============================== CODE a GARDER Fonction Afficher ==============================
'on colle notre Table_Data
'Range(Ws_Departement.Cells(1, 10), Ws_Departement.Cells(1, 9 + UBound(Table_Data))) = Table_Data 'coller les valeurs contenues dans le tableau

Invité · 02/06/2018, 04h33

Envoyé par Ducrocq Thomas

Bonjour,

Regardez l'utilisation de la fonction DateSerial pour contrôler vos dates.

**Ducrocq Thomas** · 02/06/2018, 11h35

Merci Eric pour cette piste,

j'ai toutefois du mal a comprendre ce que DateSerial peut m'apporter.
En effet si je comprend bien Dateserial il me faut déjà connaitre Month day & Years et tout mon probleme viens du mélange month and Day fait par la conversion Excel VBA

Invité · 02/06/2018, 11h55

Envoyé par Ducrocq Thomas

Cette fonction a le mérite de convertir correctement en date, une chaîne de type string contenant une date.

**Ducrocq Thomas** · 02/06/2018, 12h08

Eric a votre avis "l’erreur" d'excel ce fait t'elle

lors de l'intégration des donnée dans la variable tableau
lors de la restitution des données ?

dans le premier cas il me faut trouver comment écrire

Code :

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

1
2
3
 
Table_Data(Compteur_de_Date) = Cdate(Ws_Departement.Cells(Compteur_de_Date, 1)) ' doit devenir
Table_Data(Compteur_de_Date) = DateSerial(Year(Ws_Departement.Cells(Compteur_de_Date, 1)), Months(Ws_Departement.Cells(Compteur_de_Date, 1)), Days(Ws_Departement.Cells(Compteur_de_Date, 1)))

Up du post précédant :
Petite information rigolotte au passage si j'essaye d'ajouter le 5-12-2030 a ma liste elle ajoute automatiquement le 12 May 2030 au premier passage et le 5-12-2030 au deuxième passage.

**Ducrocq Thomas** · 02/06/2018, 14h45

bon n'ayant pas trouver de solution élégante je suis passer en force...

Mode bourrin : on

Récupération de l'année dans une colonne de mon tableau variable + récupération du mois dans une deuxième ... traitement séparer, concatenation dans un tableau variable resultat (format US) + reformatage de la cellule d'origine ...

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 
'ce qui donne 5 Janvier 2017 = 05/01/2017 => 01/05/2017 soit 1 Mai 2017
'Pour eviter cela je vais chercher l'année avec Years(...) que je svg dans une colonne de mon tableau
'et le mosi (que je svg dans une autre colonne
'enfin je regroupe le tout
 
    Dim Table_Data()
    Dim Table_Result()
    Dim Date_connue, i, j, Compteur_de_Date, Nombre_de_Ligne As Integer
    Dim Anne_Temporaire, Mois_Temporaire As Integer
    Dim date_test As Date
 
    Erase Table_Result
    Erase Table_Data
    Date_connue = 0
 'A
 '---------------- Uniquement pour le test----------------------------
   Set Ws_Departement = Sheets(8)
 
    date_test = Ws_Departement.Cells(6, 4)
    Debug.Print "DAte de la cellule en jaune est : année " & Year(date_test) & " mois " & Month(date_test)
 
    Nombre_de_Ligne = Ws_Departement.Range("A65536").End(xlUp).Row
 
    ReDim Table_Data(1 To 2, 1 To Nombre_de_Ligne)
    'Tentative de trie avec 2 Lignes (Annee // Mois
    'Remplissage du tableau qui va être testé
 
    For Compteur_de_Date = 1 To UBound(Table_Data, 2)
        Debug.Print Year(Ws_Departement.Cells(Compteur_de_Date, 1))
        If Year(Ws_Departement.Cells(Compteur_de_Date, 1)) < 1901 Then
            Table_Data(1, Compteur_de_Date) = Year(date_test)
            Table_Data(2, Compteur_de_Date) = Month(date_test)
        Else
            Table_Data(1, Compteur_de_Date) = Year(Ws_Departement.Cells(Compteur_de_Date, 1))
            Table_Data(2, Compteur_de_Date) = Month(Ws_Departement.Cells(Compteur_de_Date, 1))
        End If
    Debug.Print Table_Data(2, Compteur_de_Date) & "/01/"; Table_Data(1, Compteur_de_Date)
    Next Compteur_de_Date
  '-------------------------------------------------------------------
 
 
'B
'============================== CODE a GARDER FONCTION TEST  ==============================
 
    'On test tout le tableau DAte (Table_Data)
    'a) si on trouve la nouvelle date alors la variable Date_connue passe 1 => on s'arret la
    '(dans le TEST nouvelle date = CDate(Ws_Departement.Cells(6, 4))
    '(dans la macro nouvelle date = il s'agira de la nouvelle valeur issue Table_XSLI...)
    '
    'b )Si la variable Date_connue reste = 0 => on ne connait pas la date et on l'ajoute a la fin de la liste
 
For Compteur_de_Date = 1 To UBound(Table_Data, 2)
    If Table_Data(1, Compteur_de_Date) = Year(date_test) Then
        If Table_Data(2, Compteur_de_Date) = Month(date_test) Then
            Date_connue = 1
            Exit For
        End If
        End If
    Next Compteur_de_Date
 
'C
'============================== CODE a GARDER FONCTION AJOUT ==============================
    'b )Si la variable Date_connue reste = 0 => on ne connait pas la date et on l'ajoute a la fin de la liste
    '(dans le TEST on ajoute la nouvelle date = CDate(Ws_Departement.Cells(6, 4))
    '(dans la macro nouvelle date = il s'agira de la nouvelle valeur issue Table_XSLI...)
 
    If Date_connue = 0 Then
        Compteur_de_Date = UBound(Table_Data, 2) + 1
        ReDim Preserve Table_Data(1 To 2, 1 To Compteur_de_Date)
            Table_Data(1, Compteur_de_Date) = Year(date_test)
            Table_Data(2, Compteur_de_Date) = Month(date_test)
 
    End If
 
'============================== Affichage de TEST Partie B&C =================
    'For Compteur_de_Date = 1 To UBound(Table_Data)
    'Debug.Print Table_Data(Compteur_de_Date)
    'Next
'==================================================================
 
'D
'============================== CODE a GARDER Fonction TRIER ==============================
 
'On regarde si la premiere date du Tableau est superieure a la seconde
'si oui
'on stocke la 1 e valeur dans la variable Date_Temporaire
'on stocke la 2e valeur a la place de la 1er valeur
'on stocke la Date_Temporaire a la place de la 2e Valeur
' et ainsi de suite jusqu'a un tour de complet
'si non on passe au test de la 2e valeur avec la 3e valeur ...
 
 
'On trie les données par années (TABLE DATA 1, xxxx)
 
For i = 1 To UBound(Table_Data, 2)
    For Compteur_de_Date = 1 To UBound(Table_Data, 2) - 1
        If Table_Data(1, Compteur_de_Date) >= Table_Data(1, Compteur_de_Date + 1) Then
            If Table_Data(2, Compteur_de_Date) > Table_Data(2, Compteur_de_Date + 1) Then
                'on svg les valeur que l'on va détruire
                Anne_Temporaire = Table_Data(1, Compteur_de_Date)
                Mois_Temporaire = Table_Data(2, Compteur_de_Date)
                'on permute les valeurs n+1 a la place de n
                Table_Data(1, Compteur_de_Date) = Table_Data(1, Compteur_de_Date + 1)
                Table_Data(2, Compteur_de_Date) = Table_Data(2, Compteur_de_Date + 1)
                'on remet nos valeur n a la bonne place
                Table_Data(1, Compteur_de_Date + 1) = Anne_Temporaire
                Table_Data(2, Compteur_de_Date + 1) = Mois_Temporaire
            End If
        End If
    Next Compteur_de_Date
Next i
 
 
ReDim Table_Result(1 To UBound(Table_Data, 2))
For i = 1 To UBound(Table_Result)
    Table_Result(i) = Table_Data(2, i) & "/01/" & Table_Data(1, i)
        'If Table_Result(i) = "/01/" Then Table_Result(i) = "01/01/1900"
    Debug.Print (Table_Result(i)) 'Table_Result(i) = Table_Data(2, i) & "/" & Table_Data(1, i)
Next i
 
 
 
'Uniquement pour le test :
'Uniquement pour le test :
Range(Ws_Departement.Cells(1, 1), Ws_Departement.Cells(UBound(Table_Result), 1)).ClearContents
Range(Ws_Departement.Cells(1, 1), Ws_Departement.Cells(UBound(Table_Result), 1)).NumberFormat = "mmm/yyyy"
Range(Ws_Departement.Cells(1, 1), Ws_Departement.Cells(UBound(Table_Result), 1)) = Application.WorksheetFunction.Transpose(Table_Result)
 
 
'E
'============================== CODE a GARDER Fonction Afficher ==============================
'on colle notre Table_Data dans les "Toits" de notre maison
'Range(Ws_Departement.Cells(1, 10), Ws_Departement.Cells(1, 9 + UBound(Table_Data))) = Table_Data
'Range(Ws_Departement.Cells(1, 10), Ws_Departement.Cells(1, 9 + UBound(Table_Data))).NumberFormat ("dd/MM/yyyy") 'coller les valeurs contenues dans le tableau
 
End Sub

Je considére le topic comme résolu toute fois si qq un a une solution élégante merci de me contacter en PM pour mes archives

VBA - Variable Tableau & Trie Date

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager