【求助】求特定和值的数字组合

用过的数据还能用吗？

'每个数使用一次，不太可能是最优但接近于最优应该是没有问题的
'自己对结果进行分拆一下就可以了
Option Explicit
Sub abc()
　Dim a, b, i, j, k, m, t, cnt, n
　a = Range("b2:b" & [b2].End(xlDown).Row)
　b = [c1].Resize(, [c1].End(xlToRight).Column - 2).Value
　ReDim d(1 To 1, 1 To UBound(b, 2))
　Call bsort(a, 1, UBound(a, 1), 1, 1, 1)
　cnt = UBound(a)
　ReDim c(1 To 2, 1 To 2)
　For i = 1 To UBound(b, 2)
　　c(1, 1) = vbNullString: c(1, 2) = 10 ^ 8
　　Call combin(a, c, 0, LBound(a, 1), cnt, 0, b(1, i), vbNullString)
　　d(1, i) = c(1, 1)
　　t = Split(c(1, 1), "+")
　　For j = 1 To UBound(t)
　　　For k = 1 To cnt
　　　　If CStr(a(k, 1)) = t(j) Then a(k, 1) = vbNullString: Exit For
　　　Next
　　Next
　　For j = 1 To cnt
　　　If Len(a(j, 1)) Then m = m + 1: a(m, 1) = a(j, 1)
　　Next
　　cnt = m: m = 0
　Next
　[c2].Resize(, UBound(d, 2)) = d
End Sub
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) < a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function
Function combin(a, b, m, n, cnt, t, sum, s)
　If t = sum Then m = m + 1: b(m, 1) = s: Exit Function
　If m = 1 Then Exit Function
　If n > cnt Then Exit Function
　If t > sum Then
　　If t - sum < b(1, 2) Then b(1, 2) = t - sum: b(1, 1) = s
　　Exit Function
　Else
　　If sum - t < b(1, 2) Then b(1, 2) = sum - t: b(1, 1) = s
　End If
　Call combin(a, b, m, n + 1, cnt, t, sum, s)
　Call combin(a, b, m, n + 1, cnt, t + a(n, 1), sum, s & "+" & a(n, 1))
End Function