problème de tri VBA-E

**bernard38** · 06/06/2008, 15h19

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 :

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

**ouskel'n'or** · 06/06/2008, 16h01

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 :

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

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+

**bernard38** · 06/06/2008, 16h25

Helas

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

Cdt

**ouskel'n'or** · 06/06/2008, 19h46

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 :

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

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 :

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

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

Juste au cas où

**bernard38** · 11/06/2008, 07h48

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 :

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

problème de tri VBA-E

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager