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