Correspondance date Excel/VBA

Version imprimable

Bonjour,

Est-ce que quelqu'un pourrait expliquer pourquoi le code...
Code:

1 2 3 4 5 6 Dim DateOutput as Date DateOutput = #2/4/2013 11:56:00 PM# For iRow = 1 to 10 Worksheets(1).Cells(iRow,1) = DateOutput DateOutput = DateAdd("n", 2, DateOutput) 'incrémente la date de 2 minutes Next iRow
... ne donne pas le résultat:
04.02.2013 23:56
04.02.2013 23:58
05.02.2013 00:00
05.02.2013 00:02
05.02.2013 00:04
05.02.2013 00:06
05.02.2013 00:08
05.02.2013 00:10
05.02.2013 00:12
05.02.2013 00:14

... mais donne le résultat:
04.02.2013 23:56
04.02.2013 23:58
04.02.2013 00:00
05.02.2013 00:02
05.02.2013 00:04
05.02.2013 00:06
05.02.2013 00:08
05.02.2013 00:10
05.02.2013 00:12
05.02.2013 00:14

En exécutant le code étape par étape, la valeur DateOutput dans la fenêtre "Variables locales" de VBA indique pourtant la date du 5/2/13 à la 3ème itération, et c'est celle du 4/2/13 qui est inscrite sur la feuille Excel...

Merci pour votre aide!

Excel manipule mal les dates... amuse toi donc à jouer avec des strings pour palier à ce problème. Ou fais un truc du genre:
Code:

1 2 3 4 5 6 7 8 Sub toto() Dim DateOutput As Date DateOutput = #2/5/2013 11:56:00 PM# For iRow = 1 To 10 Worksheets(1).Cells(iRow, 3) = DateOutput DateOutput = DateAdd("s", 121, DateOutput) 'incrémente la date de 2 minutes Next iRow End Sub
Puis à chaque 59 itérations vire 59 secondes

Ca semble dû aux nombres à virgule flottante, qui n'ont pas toujours de représentation précise dans la mémoire. Certaines opérations pourraient avoir des résultats inattendus.

Le code suivant semble corriger ton problème:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub tt()
Dim DateOutput As Date
DateOutput = #2/4/2013 11:56:00 PM#
For iRow = 1 To 10
Worksheets(1).Cells(iRow, 1) = DateOutput
DateOutput = CDate(DateAdd("n", 2, DateOutput))  'incrémente la date de 2 minutes
 
'If Minute(DateOutput) = 0 And Second(DateOutput) = 0 Then
 
 TheDateOutput = DateSerial(Year(DateOutput), Month(DateOutput), Day(DateOutput))
 TheTimeOutput = TimeSerial(Hour(DateOutput), Minute(DateOutput), Second(DateOutput))
 DateOutput = CDate(TheDateOutput & " " & TheTimeOutput)
 
'End If
 
Next iRow
End Sub

En m'inspirant de la solution de EngueEngue, j'ai modifié le code de la façon suivante (et peu élégante), ce qui permet d'éviter le problème...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub main()
 
Dim DateOutput as Date
DateOutput = #2/4/2013 11:56:00 PM#
DateOutput = DateAdd("s", 1, DateOutput) 'ajoute à la date une seconde, qui sera retranchée plus bas
 
For iRow = 1 to 10
Worksheets(1).Cells(iRow,1) = DateOutput
Worksheets(1).Cells(iRow,1) = Worksheets(1).Cells(iRow,1) - 1 / 24 / 3600 'enlève la seconde inscrite précédemment
DateOutput = DateAdd("n", 2, DateOutput) 'incrémente la date de 2 minutes
Next iRow
 
End Sub

Un grand merci pour votre aide!

L'erreur de minuit :

'A minuit juste, 2 autres commandes qui ne causent pas l'erreur :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub orig()
 
Dim DateOutput As Date
 
DateOutput = #2/4/2013 11:56:00 PM#
 
For iRow = 1 To 10
 
 'A minuit juste, ces 2 commandes fonctionnent sans erreur
 
 Worksheets(2).Cells(iRow, 1) = CDate(DateValue(DateOutput) & " " & TimeValue(DateOutput))
 'Worksheets(2).Cells(iRow, 1) = CDbl(DateOutput)
 
 'A minuit juste, ces 2 commandes occasionnent une erreur de 24 heures sur la feuille Excel
 
 'Worksheets(2).Cells(iRow, 1) = DateOutput
 'Worksheets(2).Cells(iRow, 1) = CDate(DateOutput)
 
 
DateOutput = CDate(DateAdd("n", 2, DateOutput)) 'incrémente la date de 2 minutes
Next iRow
 
End Sub