XL 2010 Weekday conditionnel

GODO

XLDnaute Nouveau
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.
1567615759486.png

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.
 

Pièces jointes

  • Weekday conditionnel.xlsm
    502 KB · Affichages: 15

eriiic

XLDnaute Barbatruc
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
 

Pièces jointes

  • Weekday conditionnel.xlsm
    469.9 KB · Affichages: 4

GODO

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • Weekday conditionnel.xlsm
    469.4 KB · Affichages: 3

GODO

XLDnaute Nouveau
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.
 

Discussions similaires

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll