XL 2010 Weekday conditionnel

GODO · 4 Septembre 2019

Bonjour les expertes et les experts,
J'ai trouvé beaucoup de réponses et de très belles réalisations sur le fil tant en VBA qu'en formules excel, mais pas exactement ce que je cherchais.
Je souhaite réaliser un planning avec des dates de début et des dates de fin avec une durée en fonction des horaires de travail des jours de la semaine.
Pour répondre à mon besoin, j'ai donc récupérer un magnifique plannning que vous avez réalisé et qui correspond à ce que je recherche excèpté ses les variables des jours de la semaine.
Par exemple: je débute le lundi à 8h pour une durée de travail de 8h je devrais terminer le même lundi à 17h selon les horaires ci dessous.

Si maintenant je commence un vendredi à 8h pour une durée de 8h je devrais terminer le lundi suivant à 11h50. c'est exactement cela que je souhaiterai obtenir. Mais comme je n'ai pas de compétences en VBA je me tourne donc vers vous pour solliciter votre aide.

C'est pourquoi , si l'un ou l'une d'entre vous pouvais solutionner mon problème, je lui serait d'une très grande reconnaissance.
Pour une meilleurs compréhension je vous joins le fichier en question.
Merci par avance.

eriiic · 6 Septembre 2019

Bonjour,

c'est toujours d'actualité ?
eric

GODO · 6 Septembre 2019

Bonjour Eriiiic, oui c'est toujours d'actualité

eriiic · 7 Septembre 2019

Comme c'est souvent prise de tête les opérations sur calendriers (d'autant plus avec des journées <> 24h) j'ai fait les tests minimums.
Juste sur tes 2 exemples, plus un cas démarrant à 9h et finissant lundi AM que j'ai ajouté.
Je te laisse contrôler plus en détail, avec des périodes sur plusieurs jours, incluant ou non des WE et/ou fériés, démarrant aussi l'AM. Pas impossible qu'il reste des bugs sur des cas particuliers.
Par exemple je n'ai pas eu le courage, ni voulu surcharger le programme, de faire des arrondis à 7 décimales sur tous les calculs d'heures. Par sécurité tu devrais peut-être les ajouter.
J'ai découpé les calculs là où s'était nécessaire pour faciliter la compréhension
Option Explicit

VB:

Option Explicit

Function Datefin(deb As Date, duree As Date) As Date
    Dim hpr, dureeJ(0 To 6, 0 To 2) As Date, jo As Long, hdeb As Date, hfin As Date, rea As Date
    Dim ferie As Boolean, fini As Boolean, i As Long
   
    ' tableau des heures début-fin (7 jours !)
    hpr = Sheets("Listes").[hprod].Value
    ' tableau des durées journée-matin-am
    For i = 1 To UBound(hpr)
        dureeJ(i - 1, 1) = hpr(i, 2) - hpr(i, 1)    ' durée matin
        dureeJ(i - 1, 2) = hpr(i, 4) - hpr(i, 3)    ' durée AM
        dureeJ(i - 1, 0) = dureeJ(i - 1, 1) + dureeJ(i - 1, 2)    ' durée journée
    Next i

    Datefin = Int(deb)    ' h ramenée à 0h
    Do
        jo = Weekday(Datefin, vbMonday) - 1 ' jour (lundi=0 à dimanche=6)
        ferie = Application.CountIf(Range("feries"), Datefin) > 0
        If ferie Or dureeJ(jo, 0) = 0 Then    ' fermé
            ' rien
        ElseIf rea = 0 Then    ' Jour 1
            hdeb = deb - Int(deb)
            If hpr(jo + 1, 2) > 0 And hdeb < hpr(jo + 1, 2) Then   ' matin
                hdeb = Application.Max(hdeb, hpr(jo + 1, 1))
                hfin = Application.Min(hdeb + duree - rea, hpr(jo + 1, 2))
                rea = rea + hfin - hdeb
                hdeb = hpr(jo + 1, 3) ' pour préparer l'am
                If duree - rea <= 0 Then Datefin = Datefin + hfin: fini = True
            End If
            If hpr(jo + 1, 4) > 0 And rea < duree Then    ' am
                hdeb = Application.Max(hdeb, hpr(jo + 1, 3))
                hfin = Application.Min(hdeb + duree - rea, hpr(jo + 1, 4))
                rea = rea + hfin - hdeb
                If duree - rea <= 0 Then Datefin = Datefin + hfin: fini = True
            End If
        ElseIf duree - rea >= dureeJ(jo, 0) Then  ' jour intermédaire
            rea = rea + dureeJ(jo, 0)
            If duree - rea <= 0 Then Datefin = Datefin + Application.Max(hpr(jo + 1, 2), hpr(jo + 1, 4)): fini = True
        ElseIf duree - rea <= dureeJ(jo, 1) Then  ' fin matin
            Datefin = Datefin + hpr(jo + 1, 1) + duree - rea: fini = True
        Else  ' fin am
            rea = rea + dureeJ(jo, 1)
            Datefin = Datefin + hpr(jo + 1, 3) + duree - rea: fini = True
        End If
        If Not fini Then Datefin = Datefin + 1
    Loop Until fini
End Function

eric

PS : j'ai défini un nouveau nom 'feries' avec juste la colonne des dates

GODO · 9 Septembre 2019

Eric,
Ouahou! impressionnant! Merci beaucoup pour ton aide C'est génial!
Je passe aux essais et je te tiens au courant.
Encore mille mercis pour ta contribution.

GODO · 9 Septembre 2019

Eric,
Cela semble fonctionné dans la plupart des cas. J'ai malheureusement remarqué un bug. Ce qui ne me paraît pas choquant au vu de la complexité du code que tu as développé.
Je vais essayer d'être suffisement explicite.
Quelque soit la journée de début, si je ne met que 2h ou 5h ou 6h de durée de travail, alors la date de fin passe au jour suivant (j+1) avec une heure de départ à 8h. Le fait de faire j+1 pour les durées de 5h et de 6h est tout a fait normal pour le vendredi car je ne dispose que de 4h. Par contre n'ayant pas de connaissances en VBA je ne vois pas comment résoudre ce problème, ni même comment effectuer les arrondis à 7 décimales pour le calcul des heures.
Serais-ce abusé de te demandé d'y jeter un oeuil ?
Merci encore pour l'aide que tu voudras bien m'apporter.

eriiic · 9 Septembre 2019

Bonjour,

oui, j'avais eu la main un peu lourde dans un copié-collé de lignes de code.
Et c'est bien ce que je pensais, j'ai dû introduire des arrondis pour les tests d'heures.

VB:

Function Datefin(deb As Date, duree As Date) As Date
    Dim hpr, dureeJ(0 To 6, 0 To 2) As Date, jo As Long, hdeb As Date, hfin As Date, rea As Date
    Dim ferie As Boolean, fini As Boolean, i As Long
    
    ' tableau des heures début-fin (7 jours !)
    hpr = Sheets("Listes").[hprod].Value
    ' tableau des durées journée-matin-am
    For i = 1 To UBound(hpr)
        dureeJ(i - 1, 1) = hpr(i, 2) - hpr(i, 1)    ' durée matin
        dureeJ(i - 1, 2) = hpr(i, 4) - hpr(i, 3)    ' durée AM
        dureeJ(i - 1, 0) = dureeJ(i - 1, 1) + dureeJ(i - 1, 2)    ' durée journée
    Next i

    Datefin = Int(deb)    ' h ramenée à 0h
    Do
        jo = Weekday(Datefin, vbMonday) - 1 ' jour (lundi=0 à dimanche=6)
        ferie = Application.CountIf(Range("feries"), Datefin) > 0
        If ferie Or dureeJ(jo, 0) = 0 Then    ' fermé
            ' rien
        ElseIf rea = 0 Then    ' Jour 1
            hdeb = deb - Int(deb)
            If hpr(jo + 1, 2) > 0 And hdeb < hpr(jo + 1, 2) Then   ' matin
                hdeb = Application.Max(hdeb, hpr(jo + 1, 1))
                hfin = Application.Min(hdeb + duree - rea, hpr(jo + 1, 2))
                rea = rea + hfin - hdeb
                If Round(duree, 7) - Round(rea, 7) <= 0 Then
                    Datefin = Datefin + hfin
                    fini = True
                Else
                    hdeb = hpr(jo + 1, 3) ' pour préparer l'am
                End If
            End If
            If hpr(jo + 1, 4) > 0 And rea < duree Then    ' am
                hdeb = Application.Max(hdeb, hpr(jo + 1, 3))
                hfin = Application.Min(hdeb + duree - rea, hpr(jo + 1, 4))
                rea = rea + hfin - hdeb
                If Round(duree, 7) - Round(rea, 7) <= 0 Then
                    Datefin = Datefin + hfin
                    fini = True
                End If
            End If
        ElseIf Round(duree, 7) - Round(rea, 7) >= dureeJ(jo, 0) Then  ' jour intermédaire
            rea = rea + dureeJ(jo, 0)
            If Round(duree, 7) - Round(rea, 7) <= 0 Then Datefin = Datefin + Application.Max(hpr(jo + 1, 2), hpr(jo + 1, 4)): fini = True
        ElseIf Round(duree, 7) - Round(rea, 7) <= dureeJ(jo, 1) Then  ' fin matin
            Datefin = Datefin + hpr(jo + 1, 1) + duree - rea: fini = True
        Else  ' fin am
            rea = rea + dureeJ(jo, 1)
            Datefin = Datefin + hpr(jo + 1, 3) + duree - rea: fini = True
        End If
        If Not fini Then Datefin = Datefin + 1
    Loop Until fini
End Function

Continue avec des tests plus tordus les uns que les autres, pas impossible qu'il reste qq ajustements à faire.
eric

GODO · 9 Septembre 2019

Bien joué Eric! Le problème est résolu pour les durées de 6h. Par contre, pour les durées de 2h la date est j+1 et un début à 0h00 et pour les durées de 5h la date est j+1 et un début à 3h00. Sinon pour le vendredi tout fonctionne bien.

eriiic · 9 Septembre 2019

Il restait un arrondi oublié qui faussait un test.
Du coup j'en ai collé partout...

GODO · 9 Septembre 2019

Tu es un AS ERIC. Je termine les essais en détails, tu à réalisé une excellente performance et je ne devrais plus avoir de soucis.
MERCiiiiiiiiiiiiiiiiiiii!

XL 2010 Weekday conditionnel

GODO

XLDnaute Nouveau

Pièces jointes

eriiic

XLDnaute Barbatruc

GODO

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Pièces jointes

GODO

XLDnaute Nouveau

GODO

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Pièces jointes

GODO

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Pièces jointes

GODO

XLDnaute Nouveau

Discussions similaires