Problème d'utilisation d'une fonction

[MERLIN]

Bonsoir !!

Je travaille sur les durées de travail notamment avec mise en évidence des postes avec heures de nuit.
J'ai un petit souci avec la fonction [HNUIT].

Lorsque je l'utilise dans l'analyse de chacune des cellules j'ai un message d'erreur. Du coup, je suis obligé de passer par une étape transitoire.

Ici, par exemple, avec la macro "BOUCLE" pour le poste SE1-1800-0200-C07 que je casse en 18h00 en colonne 3 (heure de début) et en 02h00 en colonne 4 (heure de fin) je calcule les heures de nuit effectuées entre 21h00 et 06h00 en colonne 5. Si ce nombre est égal ou supérieure à 3 heures je prends le total du poste effectuée c'est-à-dire heure de fin moins heure de début soit 8 heures.

Je souhaiterais avoir directement le total de ces heures de nuit sans passer par l'étape des colonnes 3 et 4.

D'avance un grand merci.

Code :

Function HNUIT(DVac As Range, FVac As Range, Optional nd As Date = 7 / 8, Optional nf As Date = 1 / 4)

hd = DVac.Value
hf = FVac.Value

If hf > hd Then
Select Case hd
Case Is < nf: A = nf - hd
Case Is > nd: A = nd - hd
End Select
Select Case hf
Case Is < nf: A = hf - hd
Case Is > nd: A = A + hf - nd
End Select
ElseIf hf < hd Then
Select Case hd
Case Is < nd: A = 1 / 6
Case Is >= nd: A = 1 - hd
End Select
If hf > nf Then A = A - (hf - nf)
If hd < nf Then A = A + (nf - hd)
A = hf + A
Else
End If
HNUIT = A
End Function

Sub BOUCLE()

Dim heure_debut, heure_fin
Dim i, u As Integer

u = 2

For i = ActiveCell.Row To ActiveCell.End(xlDown).Row

If Len(Cells(i, u)) = 17 Then
heure_debut = CDate(Left(Mid(Cells(i, u), 5, 4), 2) & ":" & Right(Mid(Cells(i, u), 5, 4), 2))
heure_fin = CDate(Left(Mid(Cells(i, u), 10, 4), 2) & ":" & Right(Mid(Cells(i, u), 10, 4), 2))

Cells(i, u).Offset(0, 1) = heure_debut
Cells(i, u).Offset(0, 2) = heure_fin
'ici
Cells(i, u).Offset(0, 3) = HNUIT(Cells(i, u).Offset(0, 1), Cells(i, u).Offset(0, 2))

If heure_fin < heure_debut Then heure_fin = heure_fin + 1

If Cells(i, u).Offset(0, 3) >= 0.125 Then Cells(i, u).Offset(0, 4) = heure_fin - heure_debut

End If

Next i

End Sub

 

[ROGER2327]

Re : Problème d'utilisation d'une fonction

Re...

Re,

Il est toujours intéressant de comparer les durées d'exécution des solutions proposées.

Le fichier joint permet de comparer ma macro du post #10 et la macro BOUCLE de Roger.

J'ai quand même ajouté 2 tableaux VBA dans la macro BOUCLE pour la rendre plus rapide...

Avec cette modif c'est la solution la plus performante.

A+

J'en étais resté à du brut de fonderie en attendant de savoir ce que notre ami voulait exactement ; maintenant qu'on sait, un poil plus rapide :​

Sub BOUCLE0()
Dim temps!, t(), rest(), i&
Dim d!, f!, u!, v!, x
Dim md!, mf!, ms!

    temps = Timer

    If [B2] = "" Then Exit Sub

    mf = CSng(CDate("6:00"))
    md = CSng(CDate("21:00"))
    ms = CSng(1 / 8)

    t = Range([B2], [B1].End(xlDown)(2)).Value
    ReDim rest(1 To UBound(t) - 1, 1)

    For i = 1 To UBound(t) - 1

        x = CStr(t(i, 1))

        If Len(x) = 17 Then

            x = Split(x, "-")
            d = (x(1) \ 100 + (x(1) Mod 100) / 60) / 24
            f = (x(2) \ 100 + (x(2) Mod 100) / 60) / 24
            f = f - (f < d)
            u = (mf + f - Abs(mf - f)) / 2
            v = (md + d + Abs(md - d)) / 2
            v = 1 + u + f - v - d - Abs(1 + u - f) - Abs(v - d)
            u = u - d + Abs(u - d)
            u = Round(u - v * (v > 0), 6) / 2
            x = Round((d - f) * (u >= ms), 6)
            If x = 0 Then x = ""

            rest(i, 0) = u
            rest(i, 1) = x

        End If

    Next i
 
    [E2].Resize(i - 1, 2).Value = rest

    MsgBox "Durée " & Format(Timer - temps, "0.00 \s")

End Sub

Le temps d'affichage reste toujours le même, mais le temps de calcul est réduit d'un tiers.​

Bonne nuit.


ℝOGER2327
#7745

Mardi 17 Gueules 142 (Le Bétrou, théurge - fête Suprême Quarte)
23 Pluviôse An CCXXIII, 0,0109h - chiendent
2015-W07-3T00:01:35Z