Sub Comptage()
Dim regle As Range, fer As Range, couleur As Range
Dim reg, ncol%, coul, dat, rest(), i&, j%
Dim deb1&, fin1&, deb2&, fin2&, deb3&, fin3&, jour As Byte
Dim h1&, h2&, heure&, col As Variant
'---initialisation des tableaux---
Set regle = [Règle]: Set fer = [Fériés]: Set couleur = [I2:L2]
reg = regle: ncol = UBound(reg, 2)
coul = couleur
dat = Range("A4:G" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim rest(1 To UBound(dat), 1 To UBound(coul, 2))
'---codes des couleurs---
For i = 3 To UBound(reg)
For j = 1 To ncol
reg(i, j) = regle(i, j).Interior.Color
Next
Next
For j = 1 To UBound(coul, 2)
coul(1, j) = couleur(1, j).Interior.Color
Next
'---heures en minutes---
For j = 1 To ncol
reg(1, j) = Round(reg(1, j) * 1440) 'début
reg(2, j) = Round(reg(2, j) * 1440) 'fin
Next
'---dates et heures---
For i = 1 To UBound(dat)
If IsDate(dat(i, 1)) Then
deb1 = Round(dat(i, 2) * 1440): fin1 = Round(dat(i, 3) * 1440)
deb2 = Round(dat(i, 4) * 1440): fin2 = Round(dat(i, 5) * 1440)
deb3 = Round(dat(i, 6) * 1440): fin3 = Round(dat(i, 7) * 1440)
jour = Weekday(dat(i, 1), 2)
If Application.CountIf(fer, dat(i, 1)) Then jour = 7
For j = 1 To ncol
h1 = reg(1, j): h2 = reg(2, j)
heure = IIf(h1 > fin1 Or h2 < deb1, 0, _
IIf(h2 <= fin1, h2, fin1) - IIf(h1 >= deb1, h1, deb1)) _
+ IIf(h1 > fin2 Or h2 < deb2, 0, _
IIf(h2 <= fin2, h2, fin2) - IIf(h1 >= deb2, h1, deb2)) _
+ IIf(h1 > fin3 Or h2 < deb3, 0, _
IIf(h2 <= fin3, h2, fin3) - IIf(h1 >= deb3, h1, deb3))
col = Application.Match(reg(jour + 2, j), coul, 0)
If IsNumeric(col) Then rest(i, col) = rest(i, col) + heure / 1440
Next
End If
Next
'---restitution---
With couleur.Offset(2).Resize(UBound(rest))
.Value = rest
.Offset(UBound(rest)).Resize(Rows.Count - UBound(rest) - .Row + 1) = ""
End With
End Sub