求助大神棘手难题：数列组合运算，找出数列中运算结果小于误差的所有组合。

lumou

Sub zhgg()
arr = Range("A5", [b5].End(4))
bz = [b2]
ReDim scrr(1 To 10 ^ 5, 1 To 2)
brr = scrr
m = UBound(arr)
For a = 1 To m
For B = a To m
    hj = arr(a, 2) - arr(B, 2)
    If hj >= 0 Then
        i = i + 1
        brr(i, 1) = arr(a, 1) & " - " & arr(B, 1)
        brr(i, 2) = hj
    End If
Next B, a
crr = YjhSort10(brr, 1, 2, 1, i)
scbz = False
For ii = 1 To i - 1
    If brr(crr(0)(ii + 1), 2) - brr(crr(0)(ii), 2) < bz Then
        If Not scbz Then
            sci = sci + 1
            scrr(sci, 1) = brr(crr(0)(ii), 1)
            scrr(sci, 2) = brr(crr(0)(ii), 2)
            scbz = True
        End If
        sci = sci + 1
        scrr(sci, 1) = brr(crr(0)(ii + 1), 1)
        scrr(sci, 2) = brr(crr(0)(ii + 1), 2)
    Else
        If scbz Then sci = sci + 1: scbz = False
    End If
Next

Range("m5").Resize(sci, 2) = scrr
End Sub

lumou

yjh_27 发表于 2020-3-18 15:09
套用41L

arr = Range("A5", .End(4))

再次打扰您，非常抱歉。
最近同事提出想计算任意两个数据相减的结果，也就是A-B（详见附件中组合6)
我模仿您的代码写了一个，但运算老是出问题，结果少很多，代码见51楼。
我该如何修改一下合适？
再次麻烦了！

yjh_27

lumou 发表于 2020-3-21 11:26
再次打扰您，非常抱歉。
最近同事提出想计算任意两个数据相减的结果，也就是A-B（详见附件中组合6)
我 ...

用组合2代码改，删除b循环及相关

用组合1代码改
For B = 1 To m

If hj >= 0 And a<>B Then

yjh_27

就知道你会变化

n取m 自定义函数 随机 组合 排列 分组 分配
http://club.excelhome.net/thread-1526867-1-1.html
(出处: ExcelHome技术论坛)
下载10L 附件

bjs = Array(2, 2, 2, 3, 3)      ' 被减数，组合元素数
js = Array(0, 1, 2, 0, 2)        '减数，组合元素数

注意改这里，即可
bjs = Array(2, 2, 2, 3, 3,1)      ' 被减数，组合元素数
js = Array(0, 1, 2, 0, 2,1)        '减数，组合元素数

lumou

yjh_27 发表于 2020-3-21 14:10
就知道你会变化

n取m 自定义函数 随机 组合 排列 分组 分配

哈哈，非常感谢！
麻烦您了！