Sub CalculListe()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
Range("b40:f" & Range("f65536").End(xlUp).Offset(1, 0).Row).ClearContents
Dim L1%, Plage$, Jour As Date, Debut As Date, Fin As Date
Dim PH1Deb As Date, PH2Deb As Date, PH1Fin As Date, PH2Fin As Date
L1 = 4
Jour = Empty
Do
' initilisation
Plage = ""
Debut = CDate(Range("b" & L1)) + CDate(Range("c" & L1))
Fin = CDate(Range("d" & L1)) + CDate(Range("e" & L1))
PH1Deb = CDate(Range("b" & L1)) + TimeValue(Range("j4") & ":00:00")
PH1Fin = CDate(Range("b" & L1)) + TimeValue(Range("k4") & ":00:00")
PH2Deb = CDate(Range("d" & L1)) + TimeValue(Range("j5") & ":00:00")
PH2Fin = CDate(Range("d" & L1)) + TimeValue(Range("k5") & ":00:00")
If PH1Fin < PH1Deb Then PH1Fin = PH1Fin + 1
If PH2Fin < PH2Deb Then PH2Fin = PH2Fin + 1
' recherche Plage Horaire et jour
If Debut >= PH1Deb And Fin <= PH1Fin Then
Plage = Range("j4") & " à " & Range("k4") & " h"
End If
If Debut >= PH2Deb And Fin <= PH2Fin Then
Plage = Range("j5") & " à " & Range("k5") & " h"
End If
' inscription
If Plage <> "" Then
Select Case Range("b" & L1) = Jour
Case True
Select Case Range("e65536").End(xlUp) = Plage
Case True
Range("b65536").End(xlUp) = Range("b65536").End(xlUp).Text & ", " & Range("f" & L1).Text
Range("b65536").End(xlUp).Offset(0, 2) = Range("b65536").End(xlUp).Offset(0, 2) + Range("g" & L1)
Jour = Range("b" & L1)
Case False
Range("b65536").End(xlUp).Offset(1, 0) = Range("f" & L1)
Range("b65536").End(xlUp).Offset(0, 1) = Plage
Range("b65536").End(xlUp).Offset(0, 2) = Range("g" & L1)
Jour = Range("b" & L1)
End Select
Case False
Range("b65536").End(xlUp).Offset(1, 0) = Range("f" & L1)
Range("b65536").End(xlUp).Offset(0, 1) = Plage
Range("b65536").End(xlUp).Offset(0, 2) = Range("g" & L1)
Jour = Range("b" & L1)
End Select
End If
L1 = L1 + 1
Loop Until Range("g" & L1) = ""
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
End Sub