

'假设D列日期是有序的,否则就用个字典走一圈就可以了
Option Explicit
Sub abc()
Dim a, i, m
a = Range("a3:d" & Cells(Rows.Count, "d").End(xlUp).row + 1).Value
ReDim b(1 To UBound(a), 1 To 3)
For i = 1 To UBound(a) - 1
If IsNumeric(Right(a(i, 1), 1)) Then
b(m + 1, 2) = b(m + 1, 2) + a(i, 3)
b(m + 1, 3) = b(m + 1, 3) + a(i, 2) * a(i, 3)
End If
If a(i, 4) <> a(i + 1, 4) Then m = m + 1: b(m, 1) = a(i, 4)
Next
[f3].Resize(UBound(b), 3) = b
End Sub