Я не уверен, что это поможет:
Option Explicit
Sub test1()
Dim LastRow As Long, i As Long, y As Long, Count As Long
Dim Average As Double, Total As Double
Dim CurrentTime As Date, Plus5Minutes As Date
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
CurrentTime = .Range("A" & i).Value
Plus5Minutes = DateAdd("n", 5, CurrentTime)
Count = 1
Total = .Range("B" & i).Value
For y = i + 2 To LastRow
If .Range("A" & y).Value < Plus5Minutes Then
Count = Count + 1
Total = Total + .Range("B" & y).Value
Else
.Range("C" & y - 1).Value = Total / Count
End If
Next y
Next i
End With
End Sub
Результат: