Option Explicit Function LongSumEl(arr(), sm As Long, Optional ds As Long

Question

Option Explicit Function LongSumEl(arr(), sm As Long, Optional ds As Long

= 0)'Функция поиска слагаемых под нужную сумму используя динамическое программирование
'Автор MCH (Михаил Ч.) - июнь 2013
'сумма ищется по целочисленным слагаемым'в основу взят алгоритм описанный здесь
'http://forum.sources.ru/index.php?showtopic=204375'Если сумма существует, то она будет найдена
'на входе:
'arr() - одномерный массив с исходными данными'sm - искомая сумма
'ds - погрешность поиска
'на выходе одномерный массив с результатом, либо значение достигнутой точности
Dim out&(), i&, j&, k&, n&, l&, sm1&
n = sm + 0 'с верху не даем допуск sm1 = sm - ds
If n > 80000000 Or n < 0 Then Exit Function
ReDim a&(n)
For i = 1 To n: a(i) = -1: Next i
Do For i = 1 To UBound(arr)
For j = n - arr(i) To 0 Step -1 If a(j) >= 0 Then
k = j + arr(i) If a(k) = -1 Then a(k) = j
If k >= sm1 Then Exit Do End If
Next j, i Loop While False
For i = sm To 1 Step -1
If a(i) >= 0 Then k = i
Do l = l + 1
ReDim Preserve out&(1 To l) out(l) = k - a(k)
k = a(k) Loop While k
LongSumEl = out Exit Function
End If Next i
End Function вот пример такого нашел