Problème tableau et date [Résolu]

[Beaudelicius]

Bonjour forum,

j'alimente un tableau à partir d'une liste d'une feuille excel, et ensuite je retranscris les données de mon tableau sur une autre feuille excel. Le transfert se fait bien excepté les dates.
La macros inverse les mois et les jours, exemple dans ma liste de données originale, les dates sont 06/09/11, lorsque je transpose mon tableau il indique 09/06/11, mais il inverse les mois et jour seulement quand c'est possible, exemple 28/08/11, après mon transpose il garde la même valeur.

Je ne comprend pas pourquoi il inverse les jours et les mois, j'ai testé avec le mode pas à pas, lorsque j'alimente mon tableau les données sont entrées correctement, 06/09/11, c'est seulement lors du transposage que ça ne fonctionne plus.

Voici mon code:

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
 
Sub tab()
Dim i, j, x, last, statut As Integer
Dim tabSche() As Variant
Dim tabScheDate() As Date
 
Application.ScreenUpdating = False
With Sheets("Data")
.Select
 
'test si il y a des valeur
If .Range("Q3").Value = "" Then
    Application.ScreenUpdating = True
    Exit Sub
End If
 
last = .Range("Q65536").End(xlUp).Row
x = 0
    For i = 3 To last
        If i = 3 Or Cells(i, 17) <> Cells(i - 1, 17) Then
            x = x + 1
            ReDim Preserve tabSche(1 To 11, 1 To x)
            For j = 1 To 9
                tabSche(j, x) = Cells(i, 16 + j)
            Next j
            ReDim Preserve tabScheDate(1 To 2, 1 To x)
            For j = 1 To 2
                tabScheDate(j, x) = Format(Cells(i, 25 + j), "dd/mm/yy")
            Next j
        End If
    Next i
End With
 
With Sheets("TCD")
.Select
 
Range(Cells(5, 29), Cells(UBound(tabSche, 2) + 4, 37)) = Application.WorksheetFunction.Transpose(tabSche)
Range(Cells(5, 38), Cells(UBound(tabScheDate, 2) + 4, 39)) = Application.WorksheetFunction.Transpose(tabScheDate)
end sub

Merci d'avance pour votre aide

[corona]

Bonjour,
Je modifierais la ligne 28

Code :

tabScheDate(j, x) = Format(Cells(i, 25 + j), "dd/mm/yy")

Par

Code :

tabScheDate(j, x) = CDate(Cells(i, 25 + j))

Je n'ai pas testé jusqu'à la dernière ligne car n'ayant pas les mêmes données que toi, je n'ai pas pu faire le Transpose.
A éviter aussi les Select.

[Beaudelicius]

Ça ne fonctionne pas...

Le tableau s'aliment bien, c'est vraiment lorsque je transpose mon tableau que les valeurs changent.

Il y aurait-il un moyen d'indiquer lors du transposage que les valeur sont des date?

Merci

[Ormonth]

Envoyé par Beaudelicius

La macros inverse les mois et les jours, exemple dans ma liste de données originale, les dates sont 06/09/11, lorsque je transpose mon tableau il indique 09/06/11, mais il inverse les mois et jour seulement quand c'est possible, exemple 28/08/11, après mon transpose il garde la même valeur.

Je ne comprend pas pourquoi il inverse les jours et les mois...

Bonjour,

vois ceci

http://didier-gonard.developpez.com/...et-vba/#LIII-B

Tu peux essayer de passer par les N°s de série pour les manip (cf le tuto / N°s série) eux ne bougent pas, ensuite c'est une question de formatage...

cordialement,

Didier

[corona]

Bonjour,
Si les données sont correctes, c'est le bon formatage que tu dois appliquer à la cellule et pas à la variable de ton tableau lorsque tu écris dans la cellule.

[Beaudelicius]

Ok ça fonctionne, j'ai passé par les No de série.

Mon code

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
Sub Liste_schedule()
Dim i, j, x, last, statut As Integer
Dim tabSche() As Variant
Dim tabScheDate() As Long
 
Application.ScreenUpdating = False
With Worksheets("Data")
 
    'test si il y a des valeur
    If .Range("Q3").Value = "" Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
 
    last = .Range("Q65536").End(xlUp).Row
    x = 0
        For i = 3 To last
            If i = 3 Or .Cells(i, 17) <> .Cells(i - 1, 17) Then
                x = x + 1
                ReDim Preserve tabSche(1 To 10, 1 To x)
                For j = 1 To 9
                    tabSche(j, x) = .Cells(i, 16 + j)
                Next j
                ReDim Preserve tabScheDate(1 To 2, 1 To x)
                For j = 1 To 2
                    tabScheDate(j, x) = CLng(.Cells(i, 24 + j))
                Next j
            End If
        Next i
End With

Merci de votre aide!!