Bonjour,

j'ai un soucis avec des dates:

Je fais un transfert via des varaibles tableaux grâce à ce code:

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
Sub Transfert()
Dim a() As Variant, b() As Variant
Dim i As Long, j As Long, k As Long
Dim DL As Double
Dim WkR As Workbook
Application.ScreenUpdating = False
Set WkR = Workbooks.Open(Filename:="" & ThisWorkbook.Worksheets("Paramètres").Cells(6, 3) & "", WriteResPassword:="123456")
If Not (WkR.ReadOnly) Then
    With ThisWorkbook.Worksheets("Test")
        WkR.Worksheets("Test").AutoFilterMode = False
        .AutoFilterMode = False
        a = .Range("A1").CurrentRegion.Value
        b = Application.Transpose(WkR.Worksheets("Test").Range("A1").CurrentRegion.Value)
        For i = 2 To UBound(a, 1)
            If Not IsError(Application.Match(a(i, 2), Application.Index(b(), 2, 0), 0)) Then
                k = Application.Match(a(i, 2), Application.Index(b(), 2, 0), 0)
                For j = 1 To 62
                    If b(j, k) = "" Or (b(j, k) <> "" And b(j, k) <> a(i, j)) Then
                        If b(j, k) <> "" And a(i, j) = "" Then
                            b(j, k) = b(j, k)
                        Else
                            If (j = 20 Or j = 27 Or j = 27 Or j = 34 Or j = 38 Or j = 61) And a(i, j) <> "" Then
                                b(j, k) = b(j, k) & " " & a(i, j) 'si comment on garde tout
                            Else
                                b(j, k) = a(i, j)
                            End If
                        End If
                    End If
                Next j
            Else
                ReDim Preserve b(UBound(b, 1), UBound(b, 2) + 1)
                For j = 1 To 62
                    b(j, UBound(b, 2)) = a(i, j)
                Next j
            End If
        Next i
    End With
    With WkR.Worksheets("Test")
        DL = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        .Range("A1:BJ" & DL).ClearContents
        .Range("A1").Resize(UBound(b, 2), UBound(b, 1)).Value = Application.Transpose(b())
        .Range("A3:BJ" & DL).Sort Key1:=.Range("B3"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        .Range("A2:BJ2").AutoFilter
    End With
    WkR.Save
    WkR.Close
    Erase a
    Erase b
    Remise_Filtre
Else
    MsgBox "Le fichier récapitulatif est bloqué. Veuillez réessayer dans quelques minutes! Merci"
End If
Set WkR = Nothing
End Sub
et le code du classeur destination (recap) à son ouverture:

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
Sub Mise_En_Forme_Cellule()
Dim i As Double, DL As Double
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Test")
    .Activate
    .Range("E:E,G:G,H:H,J:J,K:K,M:N,P:Q,S:U,W:W,Z:AB,AD:AD,AG:AI,AK:AL,AQ:AQ,AS:AS,AV:AV,AX:AX,BA:BA,BC:BC,BF:BF,BH:BI").NumberFormat = "@"
    .Range("B:B,AM:AM").NumberFormat = "0"
    .Range("D:D,F:F,I:I,L:L,O:O,R:R,V:V,X:X,Y:Y,AC:AC,AE:AE,AF:AF,AJ:AJ,AN:AN,AO:AO,AP:AP,AR:AR,AT:AU,AW:AW,AY:AZ,BB:BB,BD:BE,BG:BG").NumberFormat = "dd/mm hh:mm"
    DL = .Cells(.Rows.Count, 2).End(xlUp).Row
   ' For i = 3 To DL
        'If .Cells(i, 4) <> "" Then .Cells(i, 4) = DateValue(.Cells(i, 4)) + TimeValue(.Cells(i, 4))
        'If .Cells(i, 6) <> "" Then .Cells(i, 6) = DateValue(.Cells(i, 6)) + TimeValue(.Cells(i, 6))
        'If .Cells(i, 9) <> "" Then .Cells(i, 9) = DateValue(.Cells(i, 9)) + TimeValue(.Cells(i, 9))
        'If .Cells(i, 12) <> "" Then .Cells(i, 12) = DateValue(.Cells(i, 12)) + TimeValue(.Cells(i, 12))
        'If .Cells(i, 15) <> "" Then .Cells(i, 15) = DateValue(.Cells(i, 15)) + TimeValue(.Cells(i, 15))
        'If .Cells(i, 18) <> "" Then .Cells(i, 18) = DateValue(.Cells(i, 18)) + TimeValue(.Cells(i, 18))
        'If .Cells(i, 22) <> "" Then .Cells(i, 22) = DateValue(.Cells(i, 22)) + TimeValue(.Cells(i, 22))
        'If .Cells(i, 24) <> "" Then .Cells(i, 24) = DateValue(.Cells(i, 24)) + TimeValue(.Cells(i, 24))
        'If .Cells(i, 25) <> "" Then .Cells(i, 25) = DateValue(.Cells(i, 25)) + TimeValue(.Cells(i, 25))
        'If .Cells(i, 29) <> "" Then .Cells(i, 29) = DateValue(.Cells(i, 29)) + TimeValue(.Cells(i, 29))
        'If .Cells(i, 31) <> "" Then .Cells(i, 31) = DateValue(.Cells(i, 31)) + TimeValue(.Cells(i, 31))
        'If .Cells(i, 32) <> "" Then .Cells(i, 32) = DateValue(.Cells(i, 32)) + TimeValue(.Cells(i, 32))
        'If .Cells(i, 36) <> "" Then .Cells(i, 36) = DateValue(.Cells(i, 36)) + TimeValue(.Cells(i, 36))
        'If .Cells(i, 40) <> "" Then .Cells(i, 40) = DateValue(.Cells(i, 40)) + TimeValue(.Cells(i, 40))
        'If .Cells(i, 41) <> "" Then .Cells(i, 41) = DateValue(.Cells(i, 41)) + TimeValue(.Cells(i, 41))
        'If .Cells(i, 42) <> "" Then .Cells(i, 42) = DateValue(.Cells(i, 42)) + TimeValue(.Cells(i, 42))
        'If .Cells(i, 44) <> "" Then .Cells(i, 44) = DateValue(.Cells(i, 44)) + TimeValue(.Cells(i, 44))
        'If .Cells(i, 46) <> "" Then .Cells(i, 46) = DateValue(.Cells(i, 46)) + TimeValue(.Cells(i, 46))
        'If .Cells(i, 47) <> "" Then .Cells(i, 47) = DateValue(.Cells(i, 47)) + TimeValue(.Cells(i, 47))
        'If .Cells(i, 49) <> "" Then .Cells(i, 49) = DateValue(.Cells(i, 49)) + TimeValue(.Cells(i, 49))
        'If .Cells(i, 51) <> "" Then .Cells(i, 51) = DateValue(.Cells(i, 51)) + TimeValue(.Cells(i, 51))
        'If .Cells(i, 52) <> "" Then .Cells(i, 52) = DateValue(.Cells(i, 52)) + TimeValue(.Cells(i, 52))
        'If .Cells(i, 54) <> "" Then .Cells(i, 54) = DateValue(.Cells(i, 54)) + TimeValue(.Cells(i, 54))
        'If .Cells(i, 56) <> "" Then .Cells(i, 56) = DateValue(.Cells(i, 31)) + TimeValue(.Cells(i, 31))
        'If .Cells(i, 57) <> "" Then .Cells(i, 57) = DateValue(.Cells(i, 31)) + TimeValue(.Cells(i, 31))
        'If .Cells(i, 59) <> "" Then .Cells(i, 59) = DateValue(.Cells(i, 31)) + TimeValue(.Cells(i, 31))
    'Next i
End With
Application.ScreenUpdating = True
End Sub
Le problème c'est que les date sont stockées en string dans ma variable tableau malgré le format personnalisé dd/mm hh:mm dans mes cellules sources et que pour pouvoir avoir les filtres "en mode date" une fois la copie faite, il faut que je les convertissent en mode date via mon second code. Petit soucis, c'est que certaines dates passent au format mm/dd hh:mm et d'autre restent au bon format dd/mm hh:mm.
Comment faire pour que toutes mes dates restent au bon format en passant par la variable tableau? Car si je fais un transfert en travaillant directement sur les cellules, le problème ne se produit pas mais le traitement est plus long

Merci d'avance pour votre aide