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 |
