Discussion :

[kokoVBA]

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 :

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
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 :

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

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.

[jfontaine]

Bonjour,

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

Code :

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

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

Bon courage

[kokoVBA]

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 :

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
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 :

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
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 :

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

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 :

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

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

[Krovax]

Bonjour
Une remarque qui n'a rien a voir avec ton programme mais c'est toujours bon à savoir

Code :

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

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 :

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

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

Code :

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

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?

[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 :

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

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)

[kokoVBA]

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 :

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

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 :

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

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+