比如一堆数据：985，985，985，985，1760，1760，545，545，385，385。怎样让他们快速分组为“和”接近3000的数据组，输出：（985，985，385，385）；（985，985，545）；（1760，545）；（1760）。有大佬做过吗？好几百的数据我一个一个对着头都晕了。

接近3000但不能超出3000

'随机排列中取指定个数求局部最优，全局很难达到最优（各组合和数极差）
'数据个数越多效果越好，可以先测试50个数据，效率应该可以
'最后一组或几组数据手工调整一下。如果目标值为和数均值还好解决一些，这目标值离均值差的太多，单个组合的组合个数还不太好控制
Option Explicit
Const SUM As Long = 3000
Sub abc()
　Dim a, i, m, n, t, d, cnt, key
　a = [a1].CurrentRegion.Resize(, 1).Value
　ReDim b(1 To UBound(a) / 2, 1 To 20) '最大组合数20
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a)
　　d(a(i, 1)) = d(a(i, 1)) + 1
　Next
　cnt = UBound(a)
　Do
　　Call rand(a, 1, cnt, 1, 1)
　　m = 0
　　For i = 1 To cnt
　　　m = m + 1
　　　If a(i, 1) > SUM Then MsgBox SUM: Exit Sub '无解
　　　a(m, 1) = a(i, 1)
　　　If m = 16 Then Exit For '最大组合数，不要超过20个数(2^20-1)
　　Next
　　t = vbNullString
　　Call combin(a, m, t)
　　t = Split(t, "+"): n = n + 1
　　For i = 1 To UBound(t)
　　　d(Val(t(i))) = d(Val(t(i))) - 1
　　　b(n, i) = t(i)
　　Next
　　cnt = 0
　　For Each key In d.keys
　　　For i = 1 To d(key)
　　　　cnt = cnt + 1
　　　　a(cnt, 1) = key
　　　Next
　　Next
　Loop Until cnt = 0
　[c1].Resize(n, UBound(b, 2)) = b
End Sub
Function combin(a, m, s)
　Dim i As Long, j As Long, n As Long, t
　ReDim b(1 To 2 ^ m, 1 To 2)
　t = 10 ^ 8
　b(2, 1) = "+" & a(1, 1): b(2, 2) = a(1, 1): n = 2
　If b(2, 2) <= SUM Then
　　If b(2, 2) = SUM Then s = b(2, 1): Exit Function
　　If SUM - b(2, 2) < t Then t = SUM - b(2, 2): s = b(2, 1)
　End If
　For i = 2 To m
　　For j = n + 1 To 2 * n
　　　b(j, 1) = b(j - n, 1) & "+" & a(i, 1)
　　　b(j, 2) = b(j - n, 2) + a(i, 1)
　　　If b(j, 2) <= SUM Then
　　　　If b(j, 2) = SUM Then s = b(j, 1): Exit Function
　　　　If SUM - b(j, 2) < t Then t = SUM - b(j, 2): s = b(j, 1)
　　　End If
　　Next
　　n = n * 2
　Next
End Function
Function rand(a, first, last, left, right)
　Dim i As Long, j As Long, n As Long, cnt As Long, t
　cnt = last - first + 1
　Randomize
　For i = first To last
　　n = Int(Rnd * cnt)
　　For j = left To right
　　　t = a(i, j): a(i, j) = a(first + n, j): a(first + n, j) = t
　　Next
　Next
End Function

'审个毛，太晕了