数据多对多组合问题，求高手指点！

ljxvba

两组数据，如何找出两组之间部分数据的对应关系，可能是一对一、一对多、多对一、多对多，如何找出这些组合，求高手指点下思路，如果用排列组合是不是有点低效啊，有更好的方法吗？

yjh_27

数字为行号

micch

这样随便组，组合的数量会有很多啊。 754=202+552  269+491=760  列出所有的组合以后，这些组合任意组合和还是相同的。754+269+491=760+202+552  以此类推

micch

有目的的求解 好办，求组合和值最大的组合，或者是求组合数字数量最多的组合，或者是其他，加个条件好办，都列出来就麻烦点

yjh_27

所有组合（一对一、一对多、多对一、多对多） 有484052种

ljxvba

micch 发表于 2020-2-19 12:05
这样随便组，组合的数量会有很多啊。 754=202+552  269+491=760  列出所有的组合以后，这些组合任意组合和 ...

应该是754+269+491=202+552+760算一组解，因为在实际解决问题的时候很可能就一组解，我想了解下高效解这类题的思路，计算量不要太大

ljxvba

yjh_27 发表于 2020-2-19 12:31
所有组合（一对一、一对多、多对一、多对多） 有484052种

膜拜大神，能不能指点下解这类题的思路呢，是怎么求出这些组合的，谢谢

micch

ljxvba 发表于 2020-2-19 22:07
应该是754+269+491=202+552+760算一组解，因为在实际解决问题的时候很可能就一组解，我想了解下高效解这 ...

5楼老师说了所有组合近5万种，所以你应该有目的的求解，实际问题是要解决什么问题，就一组解，那这一组解是什么解，有什么规则

一把小刀闯天下

'我的结果怎么会超10^6的，计时不包括输出<2s

'如果需要全部结果那就输出到文本文件吧

'----------------
'修改了一下，单个数处理有点问题。总组合数：3635489，只输出了10^6个组合，，，

Option Explicit

Sub test()
  Dim arr, i As Long, j As Long, m As Long, key, t1, t2, dt As Single
  dt = Timer
  arr = Range("a2:c" & [a2].End(xlDown).Row)
  ReDim dic(UBound(arr, 2))
  For i = 1 To 3 Step 2
    Set dic(i) = CreateObject("scripting.dictionary")
    Call comb(arr, i, dic)
  Next
  Debug.Print dic(3).Count
  If dic(3).Count Then
    ReDim arr(1 To 10 ^ 6, 1 To 3)
    For Each key In dic(3).keys
      t1 = Split(dic(1)(key), "|"): t2 = Split(dic(3)(key), "|")
      For i = 1 To UBound(t1)
        For j = 1 To UBound(t2)
          m = m + 1: arr(m, 3) = key
          arr(m, 1) = Mid(t1(i), 2): arr(m, 2) = Mid(t2(j), 2)
          If m = UBound(arr, 1) Then
            Debug.Print Timer - dt
            [n1].Resize(m, 3) = arr
            Debug.Print Timer - dt
            Exit Sub
          End If
        Next
      Next
    Next
  End If
End Sub

Function comb(arr, p As Long, dic)
  Dim i As Long, j As Long, n As Long
  ReDim brr(1 To 2 ^ UBound(arr, 1), 1 To 2)
  brr(2, 1) = "+" & arr(1, p): brr(2, 2) = arr(1, p)
  If p = 1 Then
    dic(1)(brr(2, 2)) = "|" & brr(2, 1)
  Else
    If dic(1).exists(brr(2, 2)) Then dic(p)(brr(2, 2)) = "|" & brr(2, 1)
  End If
  n = 2
  For i = 2 To UBound(arr, 1)
    For j = n + 1 To 2 * n
      brr(j, 1) = brr(j - n, 1) & "+" & arr(i, p)
      brr(j, 2) = brr(j - n, 2) + arr(i, p)
      If p = 1 Then
        dic(p)(brr(j, 2)) = dic(p)(brr(j, 2)) & "|" & brr(j, 1)
      Else
        If dic(1).exists(brr(j, 2)) Then dic(p)(brr(j, 2)) = dic(p)(brr(j, 2)) & "|" & brr(j, 1)
      End If
    Next
    n = n * 2
  Next
'  Range("k1").Offset(, p).Resize(UBound(brr, 1), 2) = brr
End Function

ljxvba

micch 发表于 2020-2-20 09:39
5楼老师说了所有组合近5万种，所以你应该有目的的求解，实际问题是要解决什么问题，就一组解，那这一组解 ...

实际问题是匹配销售订单与销售发票的问题，一个销售订单可能拆成多张发票开，也有可能多个订单开一张或者多张发票，记录数可能也就十条左右，不会太多，一般是一组解，我上传的数据是随便模拟的，也没想到会有那么多解，实际问题没有这么多解的