Sub SumChoise()
Dim aData(), aLevel()
Dim i As Long, j As Long
aData = Range("A1:F100").Value
ReDim aLevel(1 To Application.max(Range("B1:B100")), 1 To 2)
For i = 1 To UBound(aLevel): aLevel(i, 1) = i: Next i
For i = 10 To 100
For j = 4 To 5
If aData(i, 2) > 1 Then
aLevel(aData(i, 2) - 1, 2) = aLevel(aData(i, 2) - 1, 2) + aData(i, j)
Else
' для первого уровня
End If
Next j
Next i
Cells(10, 7).Resize(UBound(aLevel), 2).Value = aLevel
End Sub