如何做到

'如果有多组解随机取一组
Option Explicit
Sub abc()
　Dim i, a, sum, m
　a = Range("c3:c" & [c1].End(xlDown).Row).Value
　sum = 20 '自己改成566
　Call bsort(a, 1, UBound(a, 1), 1, 1, 1)
　ReDim b(1 To 10 ^ 4, 1 To 1) As String
　Call dfs(a, b, m, UBound(a, 1), sum, vbNullString)
　[c:c].Interior.ColorIndex = xlNone
　If m > 0 Then
　　Dim d, t
　　Set d = CreateObject("scripting.dictionary")
　　t = Split(b(Int(Rnd * m) + 1, 1), "+")
　　For i = 1 To UBound(t)
　　　d(Val(t(i))) = d(Val(t(i))) + 1
　　Next
　　For i = 3 To [c1].End(xlDown).Row
　　　If d(Cells(i, "c").Value) > 0 Then
　　　　Cells(i, "c").Interior.Color = vbGreen
　　　　d(Cells(i, "c").Value) = d(Cells(i, "c").Value) - 1
　　　End If
　　Next
　End If
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 dfs(a, b, m, n, sum, s)
　If sum = 0 Then m = m + 1: b(m, 1) = s: Exit Function
　If n < LBound(a, 1) Then Exit Function
　If sum < 0 Then Exit Function
　Call dfs(a, b, m, n - 1, sum, s)
　Call dfs(a, b, m, n - 1, sum - a(n, 1), s & "+" & a(n, 1))
End Function