Private Sub CommandButton1_Click()
tata HR:=Range("M2"), DC:=2, OF:=Range("E4"), NB:=3
End Sub
Sub tata(HR As Range, DC&, OF As Range, NB&)
Dim i&, j&, k&, l&, h#, c&, v, u() As Boolean, o()
With HR
With Range(.Cells, .End(xlToRight)) 'Plage horaire.
' La cellule à droite de la dernière donnée utile doit être vide.
v = Range(.Offset(DC), .Offset(DC).End(xlDown)).Value 'Données
l = UBound(v, 1) - 1: c = UBound(v, 2) - 1: NB = NB + NB
ReDim u(l, c)
ReDim o(l, NB)
For i = 0 To l: For j = 0 To c
u(i, j) = CBool(v(i + 1, j + 1))
Next j, i
v = .Value
End With
End With
For i = 0 To l
k = 0
For j = 0 To c
If u(i, j) <> u(i, IIf(j = 0, c, j - 1)) Then
If u(i, j) Then
If k = NB Then o(i, k) = "...": Exit For
o(i, k) = j: k = k + 2
End If
End If
Next
Next
For i = 0 To l
k = 0
Do Until IsEmpty(o(i, k)) Or k = NB
For j = o(i, k) To o(i, k) + c
If Not u(i, j Mod (c + 1)) Then
h = v(1, o(i, k) + 1): o(i, k) = h - Int(h)
h = v(1, j Mod (c + 1) + 1): o(i, k + 1) = h - Int(h) - (h = 1)
k = k + 2
Exit For
End If
Next
Loop
If k = 0 And u(i, 0) Then o(i, k) = 0: o(i, k + 1) = 1
Next
With OF.Resize(l + 1, NB + 1): .NumberFormat = "[h]:mm": .Value = o: End With 'Résultats.
End Sub