попробуйте этот алгоритм для подпоследовательности
Sub aargh()
Dim a As Variant
Dim limsum As Double, highestnum As Double
Dim i As Integer, j As Integer
a = Array(5, 4, 4, 3.8, 2, 1.7)
limsum = 12
highestsum = 0
For i = 0 To UBound(a)
s = a(i)
j = i
Do
If s > highestsum Then fs = i: ls = j: highestsum = s
j = j + 1
If j > UBound(a) Then Exit Do
s = s + a(j)
Loop While s <= limsum
Next i
MsgBox "subarray (" & fs & "," & ls & ") sum = " & highestsum
End Sub
отредактировано, чтобы включить примечания ниже и включить решение для подмножества
Sub aargh()
Dim sol(), csol()
a = Array(7, 4, 3, 2)
ReDim sol(LBound(a) To UBound(a))
ReDim csol(LBound(a) To UBound(a))
limsum = 13
findsum a, sol, csol, maxsum, limsum
ss = "array "
For i = 1 To sol(0)
ss = ss & sep & a(sol(i))
sep = ","
Next i
MsgBox ss & " sum =" & maxsum
End Sub
Sub findsum(ByRef a, ByRef sol, ByRef csol, ByRef maxsum, ByRef limsum, Optional s = 0, Optional lvl = 1, Optional si = 0)
' recursive sub
For i = si To UBound(a)
s = s + a(i)
csol(lvl) = i ' current solution contains number i
If s <= limsum Then
If s > maxsum Then ' we found a sum greater than current max we save it
maxsum = s
sol(0) = lvl
For j = 1 To lvl
sol(j) = csol(j)
Next j
End If
If i < UBound(a) Then ' pick another number
findsum a, sol, csol, maxsum, limsum, s, lvl + 1, i + 1
End If
End If
s = s - a(i)
Next i
End Sub
код оптимизирован, если массив отсортирован (по убыванию)
Sub aargh()
Dim sol(), csol()
a = Array(20, 15, 10, 7, 6, 5, 4, 3, 2)
ReDim sol(LBound(a) To UBound(a))
ReDim csol(LBound(a) To UBound(a))
limsum = 13
findsum a, sol, csol, maxsum, limsum, UBound(a)
ss = "array "
For i = 1 To sol(0)
ss = ss & sep & a(sol(i))
sep = ","
Next i
MsgBox ss & " sum =" & maxsum
End Sub
Sub findsum(ByRef a, ByRef sol, ByRef csol, ByRef maxsum, ByRef limsum, si, Optional s = 0, Optional lvl = 1)
' recursive sub
For i = si To LBound(a) Step -1
If s + a(i) > limsum Then Exit For
s = s + a(i)
csol(lvl) = i ' current solution contains number i
If s <= limsum Then
If s > maxsum Then ' we found a sum greater than current max we save it
maxsum = s
sol(0) = lvl
For j = 1 To lvl
sol(j) = csol(j)
Next j
End If
If i > LBound(a) Then ' pick another number
findsum a, sol, csol, maxsum, limsum, i - 1, s, lvl + 1
End If
End If
s = s - a(i)
If maxsum = limsum Then Exit For 'exit if exact match
Next i
End Sub
person
h2so4
schedule
02.09.2016
{5,4,4,3.8,2,1.7}
нет контрпримера, но под массивом вы подразумеваете набор (т.е. любую группу чисел) или последовательность. - person Comintern   schedule 02.09.2016