Public Sub prctri()
Dim tablo()
Dim n As Integer
Dim x As Range
Dim cel As Range
Dim m As Integer
Application.ScreenUpdating = False
Sheets("Stats").Select
tablo = Range("A100:B123")
For n = LBound(tablo, 1) To UBound(tablo, 1)
x = Split(Replace(tablo(n, 1), "H", ""), "-")
tablo(n, 1) = x(0)
tablo(n, 2) = x(1)
Next
For Each cel In Range("G50:AT90")
If cel.Value <> "" Then
x = cel.Value - Int(cel.Value)
For m = LBound(tablo, 1) To UBound(tablo, 1)
If x >= tablo(m, 1) / 24 And x < tablo(m, 2) / 24 Then
tablo(m, 3) = tablo(m, 3) + 1
End If
Next m
End If
Next
For n = LBound(tablo, 1) To UBound(tablo, 1)
tablo(n, 1) = tablo(n, 1) & "-" & tablo(n, 2) & "H"
tablo(n, 2) = tablo(n, 3)
tablo(n, 3) = ""
Next
Range("A100").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
Application.ScreenUpdating = True
End Sub