凑数之简化版【随机凑数】

autumnalRain

谢谢分享！收藏备用！

sujia2018

点赞，谢谢香川老师分享！

lj1226189

多谢!工作中有用

w9394

大师能不能解决表中的疑问，谢谢！

小花鹿

这样可以吗：
Sub test1()
Dim ar, br, cr, i&, s, su&, d, n&, tm, k&, m&, ar1, t
t = Timer
Dim c&, r&, mx&, hezhi&
Set d = CreateObject("scripting.dictionary")
Randomize
c = 2
r = 1
mx = 290
hezhi = 444
ar1 = Range("b2:b291")
ReDim cr(1 To r, 1 To c)
    Do
        s = ""
        ReDim ar(1 To mx)
        ReDim br(1 To mx)
        For i = 1 To mx
            ar(i) = ar1(i, 1)
        Next i
        su = 0
        For i = 1 To c - 1
            n = Int(Rnd() * (mx - i + 1)) + i
            su = su + ar(n)
            s = s & "+" & ar(n)
            tm = ar(n)
            ar(n) = ar(i)
            ar(i) = tm
        Next i
        For i = c To mx
            If su + ar(i) = hezhi Then
                s = s & "+" & ar(i)
                Exit Do
            End If
        Next i
    Loop Until su = hezhi
MsgBox s & "|" & Format(Timer - t, "0.00")
End Sub

shaokui123

太强大了,xiexie

1249994139

感谢分享，下载学习

gjw5665

香川老师，在不知道客户的payment应该与哪几张发票清账时，这个工具对财务特别有用。
但是有一些使用上的不便利，对于待凑数字有正有负，最后的目标值是0，也就是刚好发票和付款能捏平，貌似程序不work，程序会直接默认什么都不选，得出0.这个就有点尴尬了.

ychj526926

香川老师， 这个凑数能再次进化一下么， 就是按上图的这些数据，能不能按指定的组数，按指定组数的平均值，全部凑出来，实际可以有误差，误差大小不能太大，但是必须全部凑到指定的组里面，不能遗漏。

gorkysos

老师给力！！！用规则求解实在太慢了！