请问：每列拿出1个数进行组合

zainan0810

计算说明：
第1步、在原始数据表中，有N列，每列数据个数不等。
第2步、计算：每列各自拿出1个数，进行组合。遍历所有组合的可能。
第3步、最终显示结果：在第2步计算完成后，首先对同一行中，如果存在相同数，进行去重。然后对数组中的相同行，进行去重。即，在最终结果中，同一行不存在相同数，也不存在相同行


解释：什么是相同行，就是不看数据的排列位置，只要某行的所有数据，跟另一行的所有数据完全相同，它俩就是相同行


具体请看： 每列拿出1个数进行组合.rar (10.83 KB, 下载次数: 11)

2024-3-9 22:31 上传

点击文件名下载附件

yjh_27

参见附件。

zainan0810

yjh_27 发表于 2024-3-9 23:36
参见附件。

谢谢老师的辛苦！为了我，这个时间还没休息。有个问题，还想请老师有空的时候，再帮着改下：假设原始数据中，这4列的第1个数都是1，那么，组合时会出现这样一行：1，1，1，1。此时它就符合第3步中所说的，当同一行中，存在相同数，对这行进行去重。所以，这行最终显示的结果是1。也就是说，在结果表中，会有这样的一行存在。即，这行中，只有1这一个数

cnmlgb9998

PQ 实现。是这个效果吗？？？？？？

liulang0808

Sub 按钮2_Click()
    arr = Sheets("原始数据").[a1].CurrentRegion
    x = UBound(arr) ^ UBound(arr, 2)
    ReDim brr(1 To x, 1 To UBound(arr, 2))
    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    r = 0
    dg arr, brr, r, 1, "", d, dd
    [h1].Resize(r, UBound(brr, 2)) = brr
End Sub
Sub dg(arr, brr, r, c, str1, d, dd)
    For j = 1 To UBound(arr)
        If Len(arr(j, c)) > 0 Then
            If c = UBound(arr, 2) Then
                str2 = str1 & "," & arr(j, c)
                crr = Split(str1 & "," & arr(j, c), ",")
                dd.RemoveAll
                For k = 1 To UBound(crr)
                    dd(Val(crr(k))) = ""
                Next k
                str2 = ""
                For k = 1 To dd.Count
                    str2 = str2 & "," & WorksheetFunction.Small(dd.keys, k)
                Next k
                If Not d.exists(str2) Then
                    d(str2) = ""
                    r = r + 1
                    For k = 0 To dd.Count - 1
                        brr(r, k + 1) = dd.keys()(k)
                    Next k
                End If
            Else
                Call dg(arr, brr, r, c + 1, str1 & "," & arr(j, c), d, dd)
            End If
        End If
    Next j
End Sub

liulang0808

每列拿出1个数进行组合.zip (352.66 KB, 下载次数: 13)

2024-3-10 12:05 上传

点击文件名下载附件

模拟结果供参考

zainan0810

cnmlgb9998 发表于 2024-3-10 11:36
PQ 实现。是这个效果吗？？？？？？

对，老师是这样的

zainan0810

liulang0808 发表于 2024-3-10 12:06
模拟结果供参考

谢谢版主的指点！完全正确

yjh_27

zainan0810 发表于 2024-3-10 09:22
谢谢老师的辛苦！为了我，这个时间还没休息。有个问题，还想请老师有空的时候，再帮着改下：假设原始数据 ...

你试过会出现4个1？上传出错附件

zainan0810

yjh_27 发表于 2024-3-10 13:20
你试过会出现4个1？上传出错附件

老师，不好意思啊，才看到。在我上传的原始数据中，是没有4个1的情况，是假设每列都有1，这样在组合时，会出现4个1的情况。虽然已经解决了，但还是非常感谢老师的帮助！