[RESOLU]chevauchement de plage horaire et extraction

[jopont]

Bonjour,
Je souhaiterais extraire des durées non comprise dans des plages horaires, en VBA via un userform.
Vous trouverez les explications dans le fichier joint
merci

 

[bbb38]

Re : chevauchement de plage horaire et extraction

Bonsoir jopont, le forum,
Par avance, je te prie d’accepter mes excuses, mais dans ton exemple je n’arrive pas à retrouver le résultat que tu indiques, soit 1h 15mn (mes calculs dans le fichier ci-joint).
Peux-tu préciser ?
Cordialement,
Bernard

 

[jpb388]

Re : chevauchement de plage horaire et extraction

Bonjour à tous
Voila le fichier
bon courage
a+

 

[jopont]

Re : chevauchement de plage horaire et extraction

Bonjour,
Tout d'abord merci pour vos contributions.
A quoi correspond I% ?

Merci

 

[jopont]

Re : chevauchement de plage horaire et extraction

Avec cette macro tous les tests ne sont pas effectués.
En effet si je rentre Heure1 = 07 h 00 heure2 = 08 h 00, je devrais trouver 1 h 00 en résultat de la fonction.
De même si je rentre heure1 = 11 h 00 heure2 = 13 h 30 je devrait trouver 1 h en résultat de la fonction.
Comment faire tous les test avec des If Then...

Private Sub UserForm_Initialize()
Dim Total As Date
Dim E1 As Date, S1 As Date, E2 As Date, S2 As Date, AEntree As Date, Asortie As Date
E1 = CDate(Range("a2").Text)
S1 = CDate(Range("b2").Text)
E2 = CDate(Range("c2").Text)
S2 = CDate(Range("d2").Text)
AEntree = CDate(Range("e2").Text)
Asortie = CDate(Range("f2").Text)
If AEntrée < E1 Then
    If Asortie < E1 Then
    Total = Asortie - AEntree
    If Asortie > E1 Then
    Total = E1 - AEntree
    End If
If AEntree < S1 Then
    If Asortie > S1 Then
    Total = Total + (S1 - AEntree)
    End If
    End If

End If
End If

merci

 

[jpb388]

Re : chevauchement de plage horaire et extraction

Bonjour
i% = i as integer
La macro que vous me montrez n'est pas la mienne. Reprenez le classeur que je vous ai envoyé,faites vos changement d'heure sur ce classeur et vous verrez que cela fonctionne
pour info voici mes macros

feuil1

Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

UserForm

Private Sub UserForm_Initialize()
Dim Total As Date, I%
For I = 5 To 8
Total = Total + test1(Cells(2, I).Text)
Next
Me.Label1.Caption = Total
End Sub

Private Function test1(Cel As Date) As Date
Dim T1 As Date, T2 As Date, T3 As Date, T4 As Date
T1 = CDate(Range("a2").Text)
T2 = CDate(Range("b2").Text)
T3 = CDate(Range("c2").Text)
T4 = CDate(Range("d2").Text)
Select Case Cel
    Case Is < T1
        test1 = T1 - Cel
    Case Is > T2
        If Cel < T3 Then test1 = Cel - T2
        If Cel > T4 Then test1 = Cel - T4
End Select
End Function

vous pouvez constater que les deux n'ont rien a voir
a+
jp

 

[jopont]

Re : chevauchement de plage horaire et extraction

Ok, mais si je rentre les données suivantes :

heure1 : 12 h 15 heure2 :13 h 00
heure3 : 16 h 00 heure4 : 18 h 00
avec les même heures d'entrée sortie ( 08 : 01; 12 h 00 et 13 h 00 17 h 00)
la fonction me renvoie 1 h 15 min alors que je devrais avoir 1 h 45 min

merci

 

[jpb388]

Re : chevauchement de plage horaire et extraction

re
h1 12:15-12:00 = 00:15
h2 pas pris en compte puisque dans la tranche 13:00-17:00 inclus
h3 pas pris en compte puisque dans la tranche 13:00-17:00 inclus
h4 18:00-17:00 = 01:00

total 00:15 + 01:00= 01:15
si tu maintiens 01:45 explique moi le cheminement comme je viens de le faire
a+
jp

 

[jopont]

Re : chevauchement de plage horaire et extraction

De 12 h 15 à 13 h 00 = 45 min durée non incluse dans 08h 01 à 12 h 00 ou 13 h à 17 h 00
De 16 h 00 à 18 h 00 = 1 h puisque une heure non incluse dans la plage 13 h 00 à 17 h 00.

En fait je voudrais faire la somme de toute les durées non incluses dans les plages horaires.
merci

 

[jpb388]

Re : chevauchement de plage horaire et extraction

re
le problème venait que pour moi l'heure d'entrée était exclus, j'ai donc rectifié pour ajouter une minute à l'heure d'entré
exemple h3 sur feuille=15:00, pour la macro =15:01
tout à l'heure si au lieu de 13:00 tu aurais tapé 12:59 tu aurais obtenu 01:44

copier et coller a la place de l'ancienne

Private Function test1(Cel As Date) As Date
Dim T1 As Date, T2 As Date, T3 As Date, T4 As Date
T1 = CDate(Range("a2").Text) + TimeValue("00:01")
T2 = CDate(Range("b2").Text)
T3 = CDate(Range("c2").Text) + TimeValue("00:01")
T4 = CDate(Range("d2").Text)
Select Case Cel
    Case Is < T1
        test1 = T1 - Cel
    Case Is > T2
        If Cel < T3 Then test1 = Cel - T2
        If Cel > T4 Then test1 = Cel - T4
End Select
End Function

a+
jp

 

[jopont]

Re : chevauchement de plage horaire et extraction

Re,

avec les heures ci-dessous, j'ai toujours 2 h 15 min au lieu de 1 h 45 min.

 

[jopont]

Re : chevauchement de plage horaire et extraction

Re,

avec les heures ci-dessous, j'ai toujours 2 h 15 min au lieu de 1 h 45 min.

De 12 h 15 à 13 h 00 = 45 min durée non incluse dans 08h 01 à 12 h 00 ou 13 h à 17 h 00
De 16 h 00 à 18 h 00 = 1 h puisque une heure non incluse dans la plage 13 h 00 à 17 h 00.

 

[jpb388]

Re : chevauchement de plage horaire et extraction

Private Function test1(Cel As Date) As Date
 Dim T1 As Date, T2 As Date, T3 As Date, T4 As Date
 T1 = CDate(Range("a2").Text)
 T2 = CDate(Range("b2").Text)
 T3 = CDate(Range("c2").Text)
 T4 = CDate(Range("d2").Text)
 Select Case Cel
     Case Is < T1
         test1 = T1 - Cel
     Case Is > T2
         If Cel < T3 Then test1 = T3 - Cel
         If Cel > T4 Then test1 = Cel - T4
 End Select
 End Function

 

[jopont]

Re : chevauchement de plage horaire et extraction

ok mais si je mets 12 :00 à 13 :00 (h1et h2) et 16 : 00 à 17 : 00 (h3 et h4), j'ai 00 : 00 : 00.
Je devrais avoir 1 h00.
merci

 

[jpb388]

Re : chevauchement de plage horaire et extraction

Bonjour

Private Function test1(Cel As Date) As Date
 Dim T1 As Date, T2 As Date, T3 As Date, T4 As Date
 T1 = CDate(Range("a2").Text)
 T2 = CDate(Range("b2").Text)
 T3 = CDate(Range("c2").Text)
 T4 = CDate(Range("d2").Text)
 Select Case Cel
     Case Is < T1
         test1 = T1 - Cel
     Case Is >= T2
         If Cel <= T3 Then test1 = T3 - Cel
         If Cel > T4 Then test1 = Cel - T4
 End Select
 End Function

a+
jp