Excel VBA 質問スレ Part58

これでどうや！ｗ

Dim i, j, k As Long
i = 1: j = 1: k = 1 'i=データの行　j=書き込みセルの行 k=数列のカウント用

Do While Range("A1").End(xlDown).Row >= i

Cells(j, 3) = Cells(j, 3) + Cells(i, 2)

If Cells(i + 1, 1) <> k + 1 Then j = j + 1: k = 0
i = i + 1
k = k + 1
Loop