With .Sheets(1)
For Each A In .Range(.[I2], .[I2].End(xlDown))
If IsEmpty(d(A.Value)) Then
d(A.Value) = Array(1, A.Offset(, 7).Value)
Else
ar = d(A.Value)
ar(0) = ar(0) + 1
ar(1) = ar(1) + A.Offset(, 7).Value
d(A.Value) = ar
End If
Next
End With
.Close
End With
With Sheet1
For i = 5 To .[B65536].End(xlUp).Row Step 2
Set A = .Cells(i, 2)
A.Offset(, 4).Resize(2, 1) = Application.Transpose(d(A.Value))
Next
.Range("f19").Formula = "=f5+f7+f9+f11+f13+f15+f17"
.Range("f20").Formula = "=f6+f8+f10+f12+f14+f16+f18"
.Range("f45").Formula = "=f21+f33+f35+f37+f39+f41+f43"
.Range("f46").Formula = "=f22+f34+f36+f38+f40+f42+f44"
.Range("f47").Formula = "=f19+f45+f23+f25+f27+f29+f31"
.Range("f48").Formula = "=f20+f46+f24+f26+f28+f30+f32"