xaron
13.02.2015, 10:52
Подскажите пожалуйста как загнать в ПЛК150 макрос подбора суммы по слагаемым ?
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 + ds '
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
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
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
End If
Next j, i
For i = sm To 1 Step -1
If a(i) >= 0 Then Exit For
Next i
LongSumEl = sm - i
End Function
И вообще это реально или нет ?
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 + ds '
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
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
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
End If
Next j, i
For i = sm To 1 Step -1
If a(i) >= 0 Then Exit For
Next i
LongSumEl = sm - i
End Function
И вообще это реально или нет ?