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 |
Partager