Сумма всех комбинаций значений из столбца чисел

Sub ListAllSummationFormulas()
    Dim i As Long, j As Long, n As Long, m As Long
    Dim rng As Range
    Set rng = Cells.Find("Äàíî")
    Set rng = Range(rng.Offset(1), rng.End(xlDown))
    n = rng.Count
    m = 2 ^ n
    ReDim links(0 To n - 1) As String
    ReDim choice(0 To n - 1) As String
    ReDim sums(1 To m - 1, 1 To 1) As String
    For i = 0 To n - 1
        links(i) = rng(i + 1, 1).Address
    Next i
    For i = 1 To m - 1
        j = 0
        While choice(j) <> ""
            choice(j) = ""
            j = j + 1
        Wend
        choice(j) = links(j)
        For j = 0 To n - 1
            If choice(j) <> "" Then sums(i, 1) = sums(i, 1) & "+" & choice(j)
        Next j
        sums(i, 1) = Replace(sums(i, 1), "+", "=", , 1)
    Next i
    Set rng = Cells.Find("Ïîëó÷èòü")
    rng.EntireColumn.ClearContents
    rng = "Ïîëó÷èòü"
    Set rng = rng.Offset(1).Resize(m - 1)
    rng = sums
    rng.Formula = rng.Value
End Sub

'Ôóíêöèÿ äëÿ âû÷èñëåíèÿ ôàêòîðèàëà.
Function Fact(ByVal n As Long) As Long
    Dim i As Long
    Fact = 1
    For i = 2 To n
        Fact = Fact * n
    Next
End Function
'Ôóíêöèÿ äëÿ âû÷èñëåíèÿ íåïîëíîãî ôàêòîðèàëà.
Function Fact2(ByVal n As Long, ByVal k As Long) As Long
    Dim i As Long
    Fact2 = k + 1
    For i = k + 2 To n
        Fact2 = Fact2 * n
    Next
End Function
'Ôóíêöèÿ äëÿ âû÷èñëåíèÿ êîëè÷åñòâà ñî÷åòàíèé.
Function C(ByVal n As Long, ByVal k As Long)
    If n = k Or k = 0 Then
        C = 1
    Else
        If n - k < k Then C = Fact2(n, k) / Fact(n - k) Else C = Fact2(n, n - k) / Fact(k)
    End If
End Function
'Ïðîöåäóðà äëÿ ãåíåðàöèè ñî÷åòàíèÿ ñ èíäåêñîì id.
Sub GenerateCombination(ByRef f() As String, ByRef l() As String, ByVal i As Long, ByVal n As Long, ByVal k As Long, ByVal id As Long)
    Dim cnk As Long
    If n = k Then 'Åñëè äîøëè äëÿ ëèñòà â ëåâîé ÷àñòè òðåóãîëüíèêà Ïàñêàëÿ,
        For i = i To i + n - 1 'òî çàïîëíÿåì âåñü îñòàâøèéñÿ ìàññèâ ôîðìóë...
            f(i) = l(i)
        Next
        Exit Sub
    ElseIf k = 0 Then   '...èíà÷å, åñëè äîøëè äî ëèñòà â ïðàâîé òðåóãîëüíèêà Ïàñêàëÿ,
        For i = i To i + n - 1 'òî î÷èùàåì âåñü îñòàâøèéñÿ ìàññèâ ôîðìóë...
            f(i) = ""
        Next
        Exit Sub
    Else 'Åñëè ìû åùå íå äîøëè äî ëèñòà, òî ïðîèçâîäèì ñðàâíåíèå ñ C(n - 1, k), ÷òîáû
        cnk = C(n - 1, k) 'óçíàòü, â êàêóþ ñòîðîíó íàì äâèãàòüñÿ.
        If id < cnk Then  'Åñëè id < C(n - 1, k), òî äâèæåìñÿ ïî òðåóãîëüíèêó âëåâî, èíà÷å âïðàâî.
            f(i) = ""    'Ïðè äâèæåíèè âëåâî î÷èùàåì ñîîòâåòñòâóþùèé ýëåìåíò ìàññèâà...
            GenerateCombination f, l, i + 1, n - 1, k, id
        Else
            f(i) = l(i) 'À ïðè äâèæåíèè âïðàâî çàïîëíÿåì åãî.
            GenerateCombination f, l, i + 1, n - 1, k - 1, id - cnk
        End If
    End If
End Sub
'Ïðîöåäóðà, êîòîðàÿ âûïèñûâàåò ôîðìóëû, ñîîòâåòñòâóþùèå
'âñåâîçìîæíûì ñóììàì k ýëåìåíòîâ èç îáùåãî êîëè÷åñòâà n.
Sub KSummationFormulas()
    Dim i As Long, j As Long, n As Long, m As Long, k As Long
    Dim rng As Range
    Set rng = Cells.Find("Äàíî")
    Set rng = Range(rng.Offset(1), rng.End(xlDown))
    n = rng.Count
    Do
        k = InputBox("Ââåäèòå k - êîëè÷åñòâî ýëåìåíòîâ, êîòîðûå íåîáõîäèìî ïðîñóììèðîâàòü." & vbCr & "0 <= k <= " & n, "Ââîä k")
        If Not (k >= 0 And k <= n) Then MsgBox "k äîëæíî íàõîäèòñÿ â ïðåäåëàõ [0; " & n & "]", vbExclamation, "Îøèáêà"
    Loop Until k >= 0 And k <= n
    m = C(n, k)
    ReDim links(0 To n - 1) As String
    ReDim formulas(0 To n - 1) As String
    ReDim sums(0 To m - 1, 0 To 0) As String
    For i = 0 To n - 1
        links(i) = rng(i + 1, 1).Address
    Next i
    For i = 0 To m - 1
        GenerateCombination formulas, links, 0, n, k, i
        For j = 0 To n - 1
            If formulas(j) <> "" Then sums(i, 0) = sums(i, 0) & "+" & formulas(j)
        Next j
        sums(i, 0) = Replace(sums(i, 0), "+", "=", , 1)
    Next i
    Set rng = Cells.Find("Ïîëó÷èòü")
    rng.EntireColumn.ClearContents
    rng = "Ïîëó÷èòü"
    Set rng = rng.Offset(1).Resize(m)
    rng = sums
    rng.Formula = rng.Value
End Sub