Calcul de différence de dates

Version imprimable

Bonjour à toutes et tous,

Je suis en train d'automatiser le traitetemnt d'un fichier contenant des dates.
J'ai écritr la fonction suivante

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
40
41
42
43
44
45
46
47
 
Function Lire(ByVal NomFichier As String)
Application.ScreenUpdating = False
Workbooks.Open Filename:=NomFichier, Format:=2, Local:=False
Columns("A:A").Select
Selection.NumberFormat = "dd/mm/yyyy hh:mm:ss.000"
 
Columns("J:J").Select
Selection.NumberFormat = "hh:mm:ss.000"
 
Dim benchTypes, steps As Range
Set benchTypes = Range("B1:B" & Range("B1").End(xlDown).Row)
Set steps = Range("C1:C" & Range("C1").End(xlDown).Row)
Set dates = Range("A1:A" & Range("A1").End(xlDown).Row)
 
Dim durations() As Date
Dim stopDate As Date
Dim startDate As Date
ReDim durations(0)
 
For i = 1 To dates.Cells.Count
    If steps.Cells(i).Text = "START" Then
    startDate = dates.Cells(i).Value
    Debug.Print "Start localisé en " & i & " : " & Format(dates.Cells(i).Value, "hh:mm:ss.000")
        For j = i To dates.Cells.Count
            If steps.Cells(j).Text = "STOP" Then
            stopDate = dates.Cells(j).Value
            Debug.Print "Stop localisé " & j & " : " & dates.Cells(j).Value
            Debug.Print stopDate - startDate
            Cells(j, 10) = stopDate - startDate
            ReDim Preserve durations(UBound(durations) + 1)
            durations(UBound(durations)) = stopDate - startDate
            Exit For
            End If
        Next
    End If
Next
 
Debug.Print UBound(durations) & " Durées collectées"
 
For i = 1 To UBound(durations)
Debug.Print Format(durations(i), "hh:mm:ss.000")
Next
 
 
Application.ScreenUpdating = True
End Function

J'ai simplifié le code pour l'exemple, le but est de faire des différences de dates à la milliseconde près (faute de mieux pour excel si j'ai bien comprit).

Avec la code ci dessus, l'import de passe bien, les formatage de la colonne A est ok, les données que j'écrit dans la colonne J

Code:

Cells(j, 10) = stopDate - startDate

Sont au bon format (lire, avec les millisecondes).
Ce que je ne comprends pas, c'est pourquoi

Code:

1
2
 
Debug.Print "Start localisé en " & i & " : " & Format(dates.Cells(i).Value, "hh:mm:ss.000")

Code:

1
2
3
For i = 1 To UBound(durations)
Debug.Print Format(durations(i), "hh:mm:ss.000")
Next

Me sortent un trace à la seconde

Salut,

Si le formatage des cellules du tableur permettent d'afficher une résolution de l'ordre de la centième de seconde,
la fonction VBA Strings.Format ne le permet pas.

Essaye de récupérer le formatage en ms depuis la fonction ci-dessous.
Code:

1 2 3 4 5 6 7 8 ' renvoi le nombre de ms dans une date au format ".000" Function FormatMsInDate(d As Date) As String Dim nbMs As Double nbMs = (CDbl(d) - Int(d)) * 24 * 3600 nbMs = (nbMs - Int(nbMs)) * 1000 FormatMsInDate = "." & Right("000" & Round(nbMs), 3) End Function
Du coup adapté dans ton code :
Code:

1 2 3 For i = 1 To UBound(durations) Debug.Print Format(durations(i), "hh:mm:ss") & FormatMsInDate(durations(i)) Next
Et pour les cellules déjà formatées par Excel

Code:

Debug.Print "Start localisé en " & i & " : " & dates.Cells(i).Text

A+

Parfait, ça fonctionne il me reste un dernier problème de représentation.
Je veux mettre ces données dans un chart avec le code suivant.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim xData() ReDim xData(UBound(durations)) For i = 1 To UBound(xData) xData(i) = i Next Charts.Add ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Temps" ActiveChart.ChartType = xlXYScatterLinesNoMarkers ActiveChart.ChartTitle.Text = "Temps" ActiveChart.Axes(xlCategory).MajorUnit = 1 ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).XValues = xData() ActiveChart.SeriesCollection(1).Values = durations()
Et j'ai l'impression de retomber sur le même problème, la série ne contient que des 0 (les valeurs sont toutes en ~ 10e-5). Je suppose que c'est encore un problème de formatage mais je suis incapable de voir ou est mon erreur...

Je ne peux pas tracer avec le contenu de durations() ? Il faut que je passe par une série avec le texte formaté ?

24/07/2013, 11h39
BlueMonkey

Salut,

Le plus simple serait de pouvoir passer une plage de cellule déjà formatée

Code:

ActiveChart.SeriesCollection(1).Values = Range("c1:c13")
25/07/2013, 10h39
chronos_

C'est presque ça, merci. En fait il faut faire attention au nb de ms dans la date
Si il y à plus de 500ms dans la date

Code:

Format(durations(i), "hh:mm:ss")

va arrondir à la seconde supérieure ce qui fait que 12.604 secondes va afficher 13.604, 13 du Foramt et 604 de la méthode.

En tout cas merci du coup de patte :ccool:

Salut,

Dans ce cas là, le plus simple est de soustraire ne nombre de ms à la date ;)

Code:

1
2
3
4
5
6
7
8
' renvoi un durée au format "hh:mm:ss.000"
Public Function FormatTimeWithMs(ByVal d As Date) As String
    Dim nbMs As Double
    nbMs = (CDbl(d) - Int(d)) * 24 * 3600
    nbMs = (nbMs - Int(nbMs)) * 1000
    d = CDbl(d) - (CDbl(nbMs) / (24# * 3600# * 1000#))
    FormatMsInDate = Format(d, "hh:mm:ss") & "." & Right("000" & Round(nbMs), 3)
End Function

Du coup à l'utilisation ça devient :

Code:

1
2
3
4
 
For i = 1 To UBound(durations)
    Debug.Print FormatTimeWithMs(durations(i))
Next