Pb format date

**bboy-eazy** · 09/12/2016, 13h03

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

**Marc-L** · 09/12/2016, 19h56

Bonjour,

comme expliqué dans l'aide interne VBA et surtout dans les tutoriels de ce forum,
une date - une vraie - est avant tout un nombre !
Donc si besoin de les stocker dans une variable tableau l'effectuer au format numérique via la propriété Value2 !

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

**Docmarti** · 09/12/2016, 20h20

Interessante ta suggestion Marc.

Remplacer .value par .value2 semble eliminer bien des maux de tete causes par les dates.

Code :

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

1
2
        a = .Range("A1").CurrentRegion.Value2
        b = Application.Transpose(WkR.Worksheets("Test").Range("A1").CurrentRegion.Value2)

**bboy-eazy** · 12/12/2016, 14h14

Merci beaucoup,

C'est parfait

Pb format date [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager