Option Explicit
Option Base 1

Function БруттоРаспр(НеттоБрутто As Range)
    Dim T1(), T2(), NSum As Double, BSum As Double
    Dim N As Long, K As Long, L As Long, R1s() As Long, R2s() As Long
    '
    N = НеттоБрутто.Rows.Count
    With WorksheetFunction
        T1 = .Transpose(НеттоБрутто.Value)
        ReDim Preserve T1(2, N + 1)
        T1 = .Transpose(T1)
    End With
    ReDim T2(N, 1), R1s(0 To 0), R2s(0 To 0)
    For K = 1 To N
        If Len(T1(K, 2)) Then
            NextValue(R1s) = K
            If Len(T1(K + 1, 2)) Then NextValue(R2s) = K
        ElseIf Len(T1(K + 1, 2)) Then
            NextValue(R2s) = K
        End If
    Next
    NextValue(R2s) = N
    For L = 1 To UBound(R1s)
        K = R1s(L)
        BSum = T1(K, 2)
        If R2s(L) = K Then
            T2(K, 1) = BSum
        Else
            NSum = 0
            For K = K To R2s(L)
                NSum = NSum + T1(K, 1)
            Next
            For K = R1s(L) To R2s(L)
                T2(K, 1) = T1(K, 1) / NSum * BSum
            Next
        End If
    Next
    БруттоРаспр = T2
End Function

Property Let NextValue(Values, NewValue)
    ReDim Preserve Values(0 To UBound(Values) + 1)
    Values(UBound(Values)) = NewValue
End Property 

Option Explicit

Rem http://excelvba.ru/articles/WinAPI
#If Win64 Then
    #If VBA7 Then    ' Windows x64, Office 2010
        Declare PtrSafe Function GetTickCount Lib "Kernel32" () As LongLong
    #Else    ' Windows x64,Office 2003-2007
        Declare Function GetTickCount Lib "Kernel32" () As LongLong
    #End If
#Else
    #If VBA7 Then    ' Windows x86, Office 2010
        Declare PtrSafe Function GetTickCount Lib "Kernel32" () As Long
    #Else    ' Windows x86, Office 2003-2007
        Declare Function GetTickCount Lib "Kernel32" () As Long
    #End If
#End If
Rem Надеюсь, что GetTickCount (число миллисекунд) отработает и в новых версиях Эксель

Sub Test1()
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim ICnt1 As Long, ICnt2 As Long, ICnt3 As Long, I As Long
    Dim T0, T1, T2, T3
    Set Rng1 = Sheet1.[C2:C145] ' ИНДЕКС(ж_;СТРОКА(C1))
    Set Rng2 = Sheet1.[E2:E145] ' ж_
    Set Rng3 = Sheet1.[G2:G145] ' C2=E2 (просто так, для сравнения)
    ICnt1 = 1
    ICnt2 = 100
    ICnt3 = 1000
    Application.Calculation = xlCalculationManual
    T0 = GetTickCount
        For I = 1 To ICnt1
            Rng1.Calculate
        Next
    T1 = GetTickCount
        For I = 1 To ICnt2
            Rng2.Calculate
        Next
    T2 = GetTickCount
        For I = 1 To ICnt3
            Rng3.Calculate
        Next
    T3 = GetTickCount
    Application.Calculation = xlCalculationAutomatic
    Debug.Print "====Test1====="
    Debug.Print "DT1 = " & T1 - T0 & " ms"
    Debug.Print "DT2 = " & T2 - T1 & " ms"
    Debug.Print "DT3 = " & T3 - T2 & " ms"
    Debug.Print "DT1/ICnt1 = " & Format((T1 - T0) / ICnt1, "0.00")
    Debug.Print "DT2/ICnt2 = " & Format((T2 - T1) / ICnt2, "0.00")
    Debug.Print "DT3/ICnt3 = " & Format((T3 - T2) / ICnt3, "0.00")
End Sub

====Test1=====
DT1 = 1484 ms
DT2 = 1375 ms
DT3 = 1141 ms
DT1/ICnt1 = 1484,00
DT2/ICnt2 = 13,75
DT3/ICnt3 = 1,14

let
    from = Excel.CurrentWorkbook(){[Name="Исходник"]}[Content],
    f = (x)=>
        [val = List.First(x[#"Брутто (нераспределённый)"]),
         sum = List.Sum(x[Нетто]),
         tolst = Table.ToList(x, (y)=>{y{0}, y{1}, y{0}/sum*val})][tolst],
    gr = Table.Group(from, "Брутто (нераспределённый)", {"tmp", f}, GroupKind.Local, (s,c)=> Number.From(c<>null) ),
    cmb = List.Combine(gr[tmp]),
    frlst = Table.FromList(cmb, (x)=>x, type table [Нетто = number, #"Брутто (нераспределённый)" = number, #"Брутто (распределённый)" = number])
in
   frlst