problème de tri VBA-E

Bjr;

Pourquoi ce code ne me tri pas (en clé2) les dates en tant que dates?
(dans la portion 'tri)
ex:
30/05/2008
31/05/2008
01/06/2008
Il me fait obstinément :
01/06/2008
30/05/2008
31/05/2008

Code:

---

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 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316

Sub STATJOUR() ' ' STATJOUR Macro ' Macro enregistrée le 15/04/2008 par Bernard GUILLOU       Test = Sheets("STAT118").Range("G5").Value If Test = "" Then MsgBox ("LA FEUILLE STAT118 EST VIDE") Exit Sub End If If Test <> "% Pause" Then MsgBox ("MAUVAISES DONNÉES") Exit Sub End If   CHOIX.Show   If MonChoix.Choixfin = "fin" Then GoTo FIN End If     If MonChoix.RePonse = "A" Then site = "aurillac" Else If MonChoix.RePonse = "V" Then site = "voiron" Else MsgBox ("CHOIX NON PROPOSÉ") Exit Sub End If End If     Dim Plage As Range Dim PlageCriteres As Range Dim PlageDonnees As Range Dim CelDonnee As Range Dim CelCritere As Range Dim Trouve As Boolean Dim StCh As String Dim chaine As String Dim iPos As Integer         Cells.Select   With Selection .WrapText = False .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False     End With     Set PlageDonnees = Range("B6:B" & Range("L65536").End(xlUp).Row) For Each CelDonnee In PlageDonnees   If CelDonnee.Interior.ColorIndex = 17 Or CelDonnee.Interior.ColorIndex = 24 Then CelDonnee.EntireRow.Hidden = True End If   Next CelDonnee   Set PlageDonnees = Nothing Set CelDonnee = Nothing   'suppression lignes masquées   Dim i As Integer nbrdelignes = ActiveSheet.UsedRange.Rows.Count   For i = nbrdelignes To 1 Step -1   If Rows(i).EntireRow.Hidden = True Then Rows(i).Delete   End If Next i   'réplication dates   Set PlageDonnees = Range("B6:B" & Range("L65536").End(xlUp).Row - 1) Dim CelDonnneedate As String PlageDonnees.NumberFormat = "m/d/yyyy" For Each celdonneedate In PlageDonnees     If celdonneedate.Value <> "" Then   If Not IsDate(celdonneedate) Then datcel = Format(Right(celdonneedate, 8), "dd/mmmm/yyyy") End If 'datcel = Format(CDate(datcel), "[$-40C]dd-mmm;@") celdonneedate.Value = datcel If celdonneedate.Offset(1, 0).Value = "" Then celdonneedate.Offset(1, 0).Value = datcel Else datcel = Right(celdonneedate.Value, 8) datcel = Format(CDate(datcel), "[$-40C]dd-mmm;@")     End If End If     Next celdonneedate   Set PlageDonnees = Nothing Set celdonneedate = Nothing   'sup lignes o   Set PlageDonnees = Range("D6:D" & Range("L65536").End(xlUp).Row)     For Each CelDonnee In PlageDonnees   If CelDonnee.Value = "0" Then CelDonnee.EntireRow.Hidden = True End If   Next CelDonnee   Set PlageDonnees = Nothing Set CelDonnee = Nothing   'suppression lignes masquées   nbrdelignes = ActiveSheet.UsedRange.Rows.Count   For i = nbrdelignes To 1 Step -1   If Rows(i).EntireRow.Hidden = True Then Rows(i).Delete   End If Next i   'groupe   Range("M5").FormulaR1C1 = "Groupe" Range("L5").Copy Range("M5").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False     If site = "voiron" Then Set PlageCriteres = Range("SerHorVoiAur!$S$2:$S$44") End If If site = "aurillac" Then Set PlageCriteres = Range("SerHorVoiAur!$Z$2:$Z$49") End If   Set PlageDonnees = Range("C6:C" & Range("L65536").End(xlUp).Row)   For Each CelDonnee In PlageDonnees StCh = "YLN" iPos = InStr(1, CelDonnee.Value, StCh) + Len(StCh) + 3 chaine = Mid(CelDonnee.Value, iPos, 8) 'recup xcarac suiv yln For Each CelCritere In PlageCriteres If chaine = CelCritere.Value Then CelDonnee.Offset(0, 10).Value = CelCritere.Offset(0, -4).Value End If Next CelCritere Next CelDonnee   Set PlageCriteres = Nothing Set PlageDonnees = Nothing Set CelCritere = Nothing Set CelDonnee = Nothing   'tri       Set PlageDonnees = Range("B5:M" & Range("L65536").End(xlUp).Row) 'PlageDonnees.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _   'OrderCustom:=5, MatchCase:=False, Orientation:=xlTopToBottom, _   'DataOption1:=xlSortTextAsNormal   PlageDonnees.Sort Key1:=Range("M6"), Order1:=xlAscending, Key2:=Range("B6") _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=5, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _ DataOption2:=xlSortTextAsNumbers   Set PlageDonnees = Nothing   'couleur   Set PlageDonnees = Range("B6:B" & Range("L65536").End(xlUp).Row)   For Each CelDonnee In PlageDonnees   If CelDonnee.Value <> "" Then lig = CelDonnee.Row sngParite = Left(CelDonnee.Value, 2) Mod 2 If sngParite <> 0 Then Range("B" & lig & ":L" & lig).Interior.ColorIndex = 19 Else Range("B" & lig & ":L" & lig).Interior.ColorIndex = 40 End If End If   Next CelDonnee   Set PlageDonnees = Nothing Set CelDonnee = Nothing   'copie   Set PlageDonnees = Range("M6:M" & Range("L65536").End(xlUp).Row)   For Each CelDonnee In PlageDonnees   mois = Format(CelDonnee.Offset(0, -11).Value, "mmmm")   If CelDonnee.Value = "1" Then   lig = CelDonnee.Row i = CelDonnee.Value If site = "voiron" Then Worksheets("Voi" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("Voi1").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "VOI").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "VOI").Range("A65536").End(xlUp).Offset(1, 0) End If If site = "aurillac" Then Worksheets("A" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("A1").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "AUR").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "AUR").Range("A65536").End(xlUp).Offset(1, 0) End If   End If If CelDonnee.Value = "2" Then lig = CelDonnee.Row i = CelDonnee.Value If site = "voiron" Then Worksheets("Voi" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("Voi2").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "VOI").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "VOI").Range("A65536").End(xlUp).Offset(1, 0) End If If site = "aurillac" Then Worksheets("A" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("A2").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "AUR").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "AUR").Range("A65536").End(xlUp).Offset(1, 0) End If End If If CelDonnee.Value = "3" Then lig = CelDonnee.Row i = CelDonnee.Value If site = "voiron" Then Worksheets("Voi" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("Voi3").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "VOI").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "VOI").Range("A65536").End(xlUp).Offset(1, 0) End If If site = "aurillac" Then Worksheets("A" & i).Activate Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets("A3").Range("A65536").End(xlUp).Offset(1, 0) Worksheets(mois & "AUR").Activate Range("B5").Select Selection.AutoFilter Worksheets("STAT118").Range("B" & lig & ":L" & lig) _ .Copy Destination:=Worksheets(mois & "AUR").Range("A65536").End(xlUp).Offset(1, 0) End If   End If Next CelDonnee   Set PlageDonnees = Nothing Set CelDonnee = Nothing FIN:   Worksheets("STAT118").Activate Cells.Select Selection.EntireRow.Hidden = False Selection.Clear Range("a1").Select   MonChoix.Choixfin = "" MonChoix.RePonse = ""   End Sub

---

En effet, string ou nombre 1 est avant 30 quoi qui gna après.
Pour effectuer le tri, format ta colonne en "standard" ("general" dans le code, effectue ton trie, puis reconvertit ta colonne en format date.
En supposant que la colonne des dates soit la colonne B... Sinon tu adaptes

Code:

---

1 2 3 4 5 6 7

Columns("B:B").NumberFormat = "General" Set PlageDonnees = Range("B5:M" & Range("L65536").End(xlUp).Row) PlageDonnees.Sort Key1:=Range("M6"), Order1:=xlAscending, Key2:=Range("B6") _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=5, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _ DataOption2:=xlSortTextAsNumbers Columns("B:B").NumberFormat = "dd/mm/yy;@"

---

A+

Helas

le format des cellules change bien mais il persiste à me mettre le 01/juin/2008 avant le 30/mai/2008

Cdt

Alors tes dates sont des string, pas des dates.
Comment ces dates sont-elles saisies ou comment ta colonne est-elle renseignée ?

Je te propose un test pour te faire comprendre le problème qu'on rencontre avec les dates. Tu en as pour deux minutes.
Tu ouvres un fichier tout neuf, tu insères un userform et tu places un textbox dedans et dans le code de l'userform, tu mets cette macro.

Code:

---

1 2 3 4 5 6 7 8

Private Sub UserForm_Activate() For j = 1 To 365 LaDate = Format(CDbl(CDate("1/1/2008")) + j, "dd/mm/yyyy") TextBox1 = LaDate DoEvents Cells(j, 1) = Me.TextBox1.Text Next j End Sub

---

Tu fais F5 !
Et tu regardes la disposition des dates. Toutes celles qui sont à gauche sont considérées comme des string par Excel. Les autres comme des dates.
Change le format pour un format "Date", tu verras que ça ne change rien.
Si tu en es là, alors réponds à mes questions : Comment tes cellules sont-elles renseignées ? ;)

PS - Avec value, c'est pareil. Pour corriger ça, on doit utiliser

Code:

---

Cells(j, 1) = CDate(Me.TextBox1.Text)

---

Juste au cas où ;)

Bjr,
Excuses j'étais en congés.
Tu as raison au départ je recopie la première cellule qui contient "vendredi 06 juin 2008" dans les suivantes et je mets un format date (partie réplication dates) mais cela ne suffit pas

Code:

---

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

'réplication dates   Set PlageDonnees = Range("B6:B" & Range("L65536").End(xlUp).Row - 1) Dim CelDonnneedate As String PlageDonnees.NumberFormat = "m/d/yyyy" For Each celdonneedate In PlageDonnees     If celdonneedate.Value <> "" Then   If Not IsDate(celdonneedate) Then datcel = Format(Right(celdonneedate, 8), "dd/mmmm/yyyy") End If 'datcel = Format(CDate(datcel), "[$-40C]dd-mmm;@") celdonneedate.Value = datcel If celdonneedate.Offset(1, 0).Value = "" Then celdonneedate.Offset(1, 0).Value = datcel Else datcel = Right(celdonneedate.Value, 8) datcel = Format(CDate(datcel), "[$-40C]dd-mmm;@")     End If End If     Next celdonneedate   Set PlageDonnees = Nothing Set celdonneedate = Nothing

---