Function SumFind(Total As Double, ParamArray RngS() As Variant) As String
Dim Data(), Cll As Range, Arr(), tmp, tSum As Double
Dim i As Long, n As Long, k As Long
For i = LBound(RngS) To UBound(RngS)
For Each Cll In RngS(i)
tmp = Val(Cll.Value)
If tmp <> 0 Then
If tmp = Total Then
SumF1 = Cll.Address(0, 0): Exit Function
Else
n = n + 1
ReDim Preserve Data(1 To 2, 1 To n)
Data(1, n) = Val(Cll.Value): Data(2, n) = Cll.Address(1, 0)
End If
End If
Next
Next
Call QuickSort(Data)
ReDim Arr(1 To n)
Arr(1) = 1: tSum = Data(1, 1)
n = 1: k = 1
Do While Total <> tSum
If Arr(1) = UBound(Data, 2) Then
SumF1 = "#N/A": Exit Function
End If
If tSum > Total Then
k = Arr(n - 1) + 1
tSum = tSum - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
n = n - 1
Arr(n) = k
Else
If k = UBound(Data, 2) Then
k = Arr(n - 1) + 1
tSum = tSum - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
n = n - 1
Arr(n) = k
Else
k = k + 1
tSum = tSum + Data(1, k)
n = n + 1
Arr(n) = k
End If
End If
Loop
SumFind = GetRes(Data, Arr, n)
End Function
Private Sub QuickSort(Data)
Dim oSList As Object, sArr, S
Dim j As Long, k As Long, jk As Long, m As Long
Set oSList = CreateObject("System.Collections.SortedList")
For j = LBound(Data, 2) To UBound(Data, 2)
oSList.Item(Data(1, j)) = oSList.Item(Data(1, j)) & "," & j
Next j
sArr = Data
For j = 0 To oSList.Count - 1
S = Split(oSList.GetByIndex(j), ",")
For m = 1 To UBound(S)
jk = CLng(S(m))
k = k + 1
Data(1, k) = sArr(1, jk): Data(2, k) = sArr(2, jk)
Next m
Next j
Set oSList = Nothing
End Sub
Private Function GetRes(Data, Arr, n) As String
Dim oSList As Object, sArr, S, iKey, tmp
Dim j As Long, k As Long, jk As Long, m As Long
Set oSList = CreateObject("System.Collections.SortedList")
For j = 1 To n
tmp = CLng(Split(Data(2, Arr(j)), "$")(1))
oSList.Item(tmp) = oSList.Item(tmp) & "," & j
Next j
tmp = Empty
For j = 0 To oSList.Count - 1
S = Split(oSList.GetByIndex(j), ",")
For m = 1 To UBound(S)
jk = CLng(S(m))
tmp = tmp & "+" & Data(2, Arr(jk))
Next m
Next j
tmp = Replace(tmp, "$", "")
GetRes = "=" & Mid(tmp, 2, Len(tmp) - 1)
Set oSList = Nothing
End Function