calcul avec des heures

Version imprimable

Bonjour le forum,

je viens vers vous pour un bête calcul d'heures. Supposons que j'ai des "heures" au format hh:mn:ss dans une colonne et que je veux calculer la durée cumulée de ces heures (et m'arrêter si je dépasse un certain nombre d'heures)

J'ai essayé le code ci-dessous :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub test() Dim Duree, Tps As Date Dim i As Integer Duree = "00:00:00" For i = 1 To 39 Tps = Format(Worksheets("T1").Cells(2 + i, 2), "hh:nn:ss") Duree = DateAdd("h", Duree, Tps) Next i MsgBox Duree End Sub
mais il bug à la ligne

Code:

Tps = Format(Worksheets("T1").Cells(2 + i, 2), "hh:nn:ss")

avez-vous une idée d'une syntaxe correcte qui me permettrait de résoudre ça?

NB : dans le bout de code ci-dessus, je n'ai pas encore inséré le fait d'arrêter le cumul des heures si je dépasse un certain nombre d'heures.

Merci pour votre aide.

25/08/2009, 10h43
jfontaine

Bonjour,

Le code ci dessous fonctionne mais change de jour a partir de 24h00

Code:

tps = tps + CDate(Worksheets("T1").Cells(2 + i, 2))

Bon courage

Bonjour jfontaine,

et merci pour ta réponse. Je vais préciser ma question, puisque mon problème vient d'une macro plus complexe que celle que j'ai décrite.
Dans un autre fichier j'ai la macro 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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Type resultat
    Col_Max As Integer
    Val_Max As Date
    Col_Min As Integer
    Val_Min As Date
    Passage As Integer
    Parite As Integer
    Duree As Date
End Type
 
 
Sub Journee2()
Dim ligne, colonne, lfin, cfin, cref, j As Integer
Dim CMax, Max, CMin, Min, Tarr, compare
Dim Tab_result() As resultat
Dim pass, Tret, Amplimax, Test As Integer
 
'Déclaration des hypothèses
Tret = Worksheets("journ").Cells(2, 2).Value
Amplimax = Worksheets("journ").Cells(3, 2).Value
 
lfin = Cells(65335, 2).End(xlUp).Row
cfin = Cells(7, 256).End(xlToLeft).Column
 
ligne = 9
j = 1
 
While Worksheets("journ").Cells(ligne, 1) <> ""
 
 
    If Worksheets("journ").Cells(ligne, 4) = "" Then
        Max = "00:00:00"
    Else
        Max = Format(Worksheets("journ").Cells(ligne, 4), "hh:nn:ss")
    End If
    If Worksheets("journ").Cells(ligne, cfin) = "" Then
        Min = "24:59:59"
    Else
        Min = Format(Worksheets("journ").Cells(ligne, cfin), "hh:nn:ss")
    End If
    CMax = 4
    CMin = cfin
 
    For colonne = 5 To cfin
        If Worksheets("journ").Cells(ligne, colonne) = "" Then
            compare = "00:00:00"
        Else
            compare = Format(Worksheets("journ").Cells(ligne, colonne), "hh:nn:ss")
            If DateDiff("s", Max, compare) > 0 Then
                Max = compare
                CMax = colonne
            End If
        End If
    Next
 
    For colonne = cfin - 1 To 4 Step -1
        If Worksheets("journ").Cells(ligne, colonne) = "" Then
                compare = "00:00:00"
    Else
            compare = Format(Worksheets("journ").Cells(ligne, colonne), "hh:nn:ss")
            If DateDiff("s", Min, compare) < 0 Then
                Min = compare
                CMin = colonne
            End If
        End If
    Next
 
    Duree = Format(Worksheets("journ").Cells(ligne, 21), "hh:nn:ss")
    Cells(ligne, 22).Value = Abs(Cells(7, CMin).Value - Cells(7, CMax).Value) / 1000
 
    ReDim Preserve Tab_result(ligne - 9)
    Tab_result(ligne - 9).Col_Max = CMax
    Tab_result(ligne - 9).Col_Min = CMin
    Tab_result(ligne - 9).Val_Max = Max
    Tab_result(ligne - 9).Val_Min = Min
    Tab_result(ligne - 9).Parite = Worksheets("journ").Cells(ligne, 1)
    Tab_result(ligne - 9).Duree = Duree
 
ligne = ligne + 1
Wend
 
pass = 1
j = 0
 
For i = 0 To UBound(Tab_result)
 
suivants:
    If Tab_result(i).Passage = 0 Then
        Tab_result(i).Passage = pass
        Worksheets("journ").Cells(i + 9, 24 + j) = pass
        Duree = DateDiff("h", Cells(4, 2), Format(Worksheets("journ").Cells(4, 2), "hh:nn:ss"))
        For h = 0 To UBound(Tab_result)
 
        Test = DateAdd("h", Tab_result(i).Duree, Duree)
       'Test = DateDiff("h", DateAdd("h", Tab_result(i).Duree, Duree), Format(Worksheets("journ").Cells(h + 9, 21), "hh:nn:ss"))
            If Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max) <> "" Then
                If DateDiff("n", Tab_result(i).Val_Max, Format(Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max), "hh:nn:ss")) > Tret _
                And Test < Amplimax _
                And Tab_result(i).Parite <> Tab_result(h).Parite _
                And Tab_result(h).Col_Min = Tab_result(i).Col_Max And Tab_result(h).Passage = 0 Then
                    pass = pass + 1
                    Duree = DateAdd("h", Duree, Tab_result(h).Duree)
                    'Duree = Duree + Tab_result(h).Duree
                    i = h
                    GoTo suivants
                End If
            End If
        Next
    End If
 
    pass = 1
    Duree = DateDiff("h", Cells(4, 2), Format(Worksheets("journ").Cells(4, 2), "hh:nn:ss"))
    i = j
    j = j + 1
Next
 
End Sub

Le noyau de cette macro est cette partie du code :

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
For i = 0 To UBound(Tab_result)
 
suivants:
    If Tab_result(i).Passage = 0 Then
        Tab_result(i).Passage = pass
        Worksheets("journ").Cells(i + 9, 24 + j) = pass
        Duree = DateDiff("h", Cells(4, 2), Format(Worksheets("journ").Cells(4, 2), "hh:nn:ss"))
        For h = 0 To UBound(Tab_result)
 
        Test = DateAdd("h", Tab_result(i).Duree, Duree)
       'Test = DateDiff("h", DateAdd("h", Tab_result(i).Duree, Duree), Format(Worksheets("journ").Cells(h + 9, 21), "hh:nn:ss"))
            If Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max) <> "" Then
                If DateDiff("n", Tab_result(i).Val_Max, Format(Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max), "hh:nn:ss")) > Tret _
                And Test < Amplimax _
                And Tab_result(i).Parite <> Tab_result(h).Parite _
                And Tab_result(h).Col_Min = Tab_result(i).Col_Max And Tab_result(h).Passage = 0 Then
                    pass = pass + 1
                    Duree = DateAdd("h", Duree, Tab_result(h).Duree)
                    'Duree = Duree + Tab_result(h).Duree
                    i = h
                    GoTo suivants
                End If
            End If
        Next
    End If
 
    pass = 1
    Duree = DateDiff("h", Cells(4, 2), Format(Worksheets("journ").Cells(4, 2), "hh:nn:ss"))
    i = j
    j = j + 1
Next

et mon problème précis est sur cette ligne :

Code:

Test = DateAdd("h", Tab_result(i).Duree, Duree)

En effet, cette variable Test n'est jamais incrémentée alors qu'elle le devrait pour que la macro marche complètement.
J'ai suivi le déroulement de la macro en mode pas à pas, et le problème est que

Code:

Tab_result(i).Duree

est au format hh:mn:ss alors que duree est au format "hh:mn:ss" avec les guillemets et j'ai l'impression que c'est ça qui empêche le cumul de temps.
J'espère que j'ai été clair.

Merci

25/08/2009, 11h26
Krovax
Bonjour
Une remarque qui n'a rien a voir avec ton programme mais c'est toujours bon à savoir
Code:

1 2 3 4 Dim ligne, colonne, lfin, cfin, cref, j As Integer Dim CMax, Max, CMin, Min, Tarr, compare Dim pass, Tret, Amplimax, Test As Integer
Ici j et test sont des integer tous les autres sont des variants

essaye
Code:

1 2 3 4 5 Sub test1() Dim i, j As Integer i = 655555 MsgBox i End Sub
Code:

1 2 3 4 5 Sub test2() Dim ias integer, j As Integer i = 655555 MsgBox i End Sub
Le deuxième plante c'est normale les integer sont limité et le premier fonction car i est un variant

Un peu de lecture
Fondements sur les variables et les constantes

Edit tant que l'on est dans la déclaration de variable tu as déclaré Duree?
25/08/2009, 11h43
kokoVBA

Bonjour Krovax,

Merci pour ta référence littéraire ;), de toutes façons je suis bloqué alors un peu de lecture ne me fera pas de mal.

Sinon oui j'ai bien déclaré

Code:

Duree as date

Merci et à+

Edit : j'ai corrigé les déclarations de variables comme indiqué dans le tuto. (ça ne change pas le fonctionnement de la macro, mais c'est plus propre)

re,
alors voilà j'ai contourné le problème en utilisant une formule matricielle dans Excel dont le résultat est utilisé dans la macro.
Le coeur de la macro devient :
Code:

1 2 3 4 5 6 If Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max) <> "" Then If DateDiff("n", Tab_result(i).Val_Max, Format(Worksheets("journ").Cells(h + 9, Tab_result(i).Col_Max), "hh:nn:ss")) > Tret _ And Cells(5, cfin + 5 + k) + Cells(9 + i, cfin + 2) < Amplimax _ And Tab_result(i).Parite <> Tab_result(h).Parite _ And Tab_result(h).Col_Min = Tab_result(i).Col_Max And Tab_result(h).Passage = 0 Then pass = pass + 1
où la formule matricielle en question se trouve dans les cellules

Code:

Cells(5, cfin + 5 + k)

La macro converti les dates de ces cellules en nombre reels compris entre 0 et 1, ce qui est bien suffisant pour faire les comparaisons qui me servent.
A+