Calcul ecart de temps

**Petit Rasta** · 20/05/2011, 10h08

Bonjour,

Je suis en train de mettre en place un fichier excel qui va me permettre de calculer l'écart entre deux heures.
En fait, dans mon fichier excel j'ai des données qui sont mises à jour, quand une certaine donnée passe à 1 je dois déclencher mon compteur de temps. Puis si elle passe à 0 je dois le stopper. Si elle repasse à 1, je dois le redémarrer.
Ainsi de suite jusqu'à ce que l'utilisateur clique sur un bouton RAZ qui remette tout à 0.
J'ai trouver des fonctions comme

Code :

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

DateDiff("s", date1, date2)

mais ça ne me convient pas parce que je veux avoir un écart en seconde mais également en minute voir en heure.
Pourriez-vous m'aider ?
Merci par avance.

**mercatog** · 20/05/2011, 10h22

Bonjour
Analyse ce petit test

Code :

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

1
2
3
4
5
6
7
8
9
Sub Test()
Dim T1 As Date, T2 As Date
Dim S As Long
 
T1 = TimeValue("01:13:45")
T2 = TimeValue("06:51:21")
S = DateDiff("s", T1, T2)
MsgBox S & "   :   " & TimeSerial(0, 0, S)
End Sub

**Petit Rasta** · 20/05/2011, 10h34

Merci bien pour ce bout de code !

Quand je le test il marche très bien par contre quand je le modifie avec ce que je veux faire j'ai un petit problème de dépassement de capacité ...

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
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
 
Dim tempDepart As Date
Dim tempsArret As Date
Dim tempsExecution As Date
 
 
Dim T1 As Date, T2 As Date
Dim S As Long
 
If Feuil1.Range("A1").Value = 1 Then
tempsDepart = Time
 
End If
 
If Feuil1.Range("A1").Value = 0 Then
 
tempsArret = Time
S = DateDiff("s", tempsDepart, tempsArret)
MsgBox S & "   :   " & TimeSerial(0, 0, S)
End If
 
End Sub

La fonction Time renvoie la même chaine que tu passes à TimeValue nan ?

**mercatog** · 20/05/2011, 11h07

En effet, les paramètres de TimeSerial(h,m,s) sont des Integer

Il faudra faire le calcul basique

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
Option Explicit
Dim TempsDepart As Date, TempsArret As Date, TempsExecution As Date
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim S As Long, H As Long, M As Long
 
If Range("A1").Value = 1 Then TempsDepart = Time
If Range("A1").Value = 0 Then
    TempsArret = Time
    S = DateDiff("s", TempsDepart, TempsArret)
    H = Int(S / 3600)
    M = Int((S - 3600 * H) / 60)
    S = S - 3600 * H - 60 * M
    MsgBox TimeSerial(H, M, S)
End If
End Sub

**Petit Rasta** · 20/05/2011, 11h32

Je ne comprends pas ce que fait la fonction TimeSerial ...
En tout cas la ligne suivante m'affiche l'heure courante du système et pas l'écart de temps entre mes deux changements de valeur :

Code :

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

MsgBox TimeSerial(H, M, S)

J'ai essayé en laissant quelques secondes et plusieurs minutes et le résultat est le même.

**mercatog** · 20/05/2011, 11h52

Parce que ton heure de départ est nulle, c'est pourquoi le Msgbox indique l'heure actuelle

tu peux utiliser

Code :

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

MsgBox H &":" & M & ":" & S

Essaies ce code pour voir

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
Dim TempsDepart As Date, TempsArret As Date, TempsExecution As Date
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim S As Long, H As Long, M As Long
 
If Range("A1").Value = 1 Then TempsDepart = Time
MsgBox "temps départ: " & TempsDepart
If Range("A1").Value = 0 Then
    TempsArret = Time
    MsgBox "temps arrêt: " & TempsArret
    S = DateDiff("s", TempsDepart, TempsArret)
    H = Int(S / 3600)
    M = Int((S - 3600 * H) / 60)
    S = S - 3600 * H - 60 * M
    MsgBox H & ":" & M & ":" & S
End If
End Sub

**Petit Rasta** · 20/05/2011, 13h04

Toutes mes excuses, le code fonctionnait bien !

Grâce à vous j'ai bien avancé, je lance mon compteur de temps.
J'ai essayé de bidouiller une solution pour pouvoir accumuler du temps dans une variable mais ce n'est pas concluant.
Je résume ce que je veux obtenir :

Code :

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

If Range("A1").Value = 1 Then TempsDepart = Time

Mon compteur se met en route.

Code :

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

1
2
3
4
5
6
7
8
If Range("A1").Value = 0 Then
    TempsArret = Time
    S = DateDiff("s", TempsDepart, TempsArret)
    H = Int(S / 3600)
    M = Int((S - 3600 * H) / 60)
    S = S - 3600 * H - 60 * M
    TempsExecution = TempsExecution + TimeSerial(H, M, S)
    MsgBox TempsExecution

Mon compteur est stoppé et le résultat est conserver dans la variable TempsExecution.

Le problème c'est que

Code :

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

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

est appelé à chaque fois qu'une cellule est modifiée.
Du coup quand ma cellule A1 reste à 0 alors que d'autres cellules changent de valeur le code contenu dans mon

Code :

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

If Range("A1").Value = 0 Then

est généré. Ce qui me fausse totalement mon compteur ...
Est-il possible de détecter lorsqu'une certaine cellule change d'état ?

Je ne sais pas si mon explication est claire donc n'hésitez pas à me demander plus de détails. Je met le code complet ci-dessous :

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
 
Option Explicit
Dim TempsDepart As Date, TempsArret As Date, TempsExecution As Date
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim S As Long, H As Long, M As Long
 
If Range("A1").Value = 1 Then TempsDepart = Time
If Range("A1").Value = 0 Then
    TempsArret = Time
    S = DateDiff("s", TempsDepart, TempsArret)
    H = Int(S / 3600)
    M = Int((S - 3600 * H) / 60)
    S = S - 3600 * H - 60 * M
    TempsExecution = TempsExecution + TimeSerial(H, M, S)
    MsgBox TempsExecution
End If
End Sub
 
Private Sub Worksheet_Activate()
MsgBox "La Feuil1 est activée"
TempsExecution = "00:00:00"
MsgBox "TempsExecution :" & TempsExecution
End Sub

**mercatog** · 20/05/2011, 13h15

Le Target désigne la plage de cellules sélectionnées
tu peux tester l'adresse (par exemple)

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
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim S As Long, H As Long, M As Long
 
If Target.Address = "$A$1" Then
    If Range("A1").Value = 1 Then TempsDepart = Time
    MsgBox "temps départ: " & TempsDepart
    If Range("A1").Value = 0 Then
        TempsArret = Time
        MsgBox "temps arrêt: " & TempsArret
        S = DateDiff("s", TempsDepart, TempsArret)
        H = Int(S / 3600)
        M = Int((S - 3600 * H) / 60)
        S = S - 3600 * H - 60 * M
        TempsExecution = TempsExecution + TimeSerial(H, M, S)
        MsgBox TempsExecution
    End If
End If
End Sub

**Didier Gonard** · 20/05/2011, 13h16

Bonjour,

vois dans ce tuto, ce chapitre :

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

cordialement,

Didier

**Petit Rasta** · 20/05/2011, 14h08

Merci pour ces deux aides !

Je crois que j'ai mal interprété la fonction

Code :

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

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Ra

Le changement de valeur se fait automatiquement sans intervention humaine dans la classeur. La cellule récupère d'elle même les valeurs.
J'ai fait une 'simulation' de ce changement de valeur et je m'aperçois que rien ne se passe ...

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
Dim TempsDepart As Date, TempsArret As Date, TempsExecution As Date
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim S As Long, H As Long, M As Long
 
If Target.Address = "$A$1" Then
 
    If Range("A1").Value = 1 Then
    TempsDepart = Time
    MsgBox "temps départ: " & TempsDepart
    End If
 
    If Range("A1").Value = 0 Then
        TempsArret = Time
        MsgBox "temps arrêt: " & TempsArret
        S = DateDiff("s", TempsDepart, TempsArret)
        H = Int(S / 3600)
        M = Int((S - 3600 * H) / 60)
        S = S - 3600 * H - 60 * M
        TempsExecution = TempsExecution + TimeSerial(H, M, S)
        MsgBox TempsExecution
        Range("B1").Value = TempsExecution
    End If
End If
End Sub
 
Private Sub Worksheet_Activate()
MsgBox "La Feuil1 est activée"
TempsExecution = "00:00:00"
MsgBox "TempsExecution0 :" & TempsExecution
 
Range("A1").Value = 1
Sleep 20000
Range("A1").Value = 0
End Sub

**mercatog** · 20/05/2011, 14h19

L'évènement Worksheet_SelectionChange se déclenche quand une cellule (ou plage de cellules) est sélectionnée

**Petit Rasta** · 20/05/2011, 14h45

Oui effectivement si j'ouvre pas les yeux ça va pas marcher ...
Je crois que je suis arrivé à mon résultat

Je pense qu'on aura l'occasion de se recroiser

Un grand merci !

**mercatog** · 20/05/2011, 15h34

Je crois que je suis arrivé à mon résultat

Lequel?
ça serait utile pour quelqu'un d'autre

**Petit Rasta** · 23/05/2011, 11h16

Je me suis enflammé un petit peu ...
En fait dans mon document Excel, j'ai une feuille qui récupère les valeurs d'un automate automatique via un logiciel sur le PC.
En gros dans mes cellules j'ai la valeur 0 à 1 qui varie automatiquement.
Or la

Code :

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

sub Private Sub Worksheet_change(ByVal Target As Excel.Range)

ne détecte pas ce changement de valeur.
Mon code est exécuté que quand je le change manuellement ou directement avec le code :

Code :

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

Range("A1").Value = 1

.
Comment je pourrais faire pour que ça fonctionne dans ces conditions ?

[Edit] Je me suis orienté vers une solution avec les DDE.

Calcul ecart de temps [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager