[已解决]根据行列数据出现个数组合数据(新增行列个数条件）请老师看一下代码怎么修改。在线等

cutecpu

sanpiao 发表于 2021-4-15 21:36
老师在线期待您的解答

Dim x, y, arr, v, r, m, sumx
Sub demo()
   d1 = Range("u3:z" & [u3].End(xlDown).Row)
   d2 = Range("ab3:ag" & [u3].End(xlDown).Row)
   d3 = Range("ai3:an" & [u3].End(xlDown).Row)
   d4 = Range("ap3:au" & [u3].End(xlDown).Row)
   r = 3
   For d = 1 To UBound(d1)
      [e2:j2] = Application.Index(d1, d, 0)
      [e9:j9] = Application.Index(d2, d, 0)
      [d3:d8] = Application.Transpose(Application.Index(d3, d, 0))
      [k3:k8] = Application.Transpose(Application.Index(d4, d, 0))
      x = Range("D3:E8"): y = Range("E2:J3"): arr = Range("E3:J8")
      For i = 1 To UBound(x)
         x(i, 2) = Cells(i + 2, "k")
      Next
      For i = 1 To UBound(y, 2)
         y(2, i) = Cells(9, i + 4)
      Next
      sumx = Application.Sum(x): ReDim v(1 To sumx)
      Call com(1, 1, 1, 1)
   Next
End Sub
Sub com(n As Integer, k As Integer, c As Integer, xx As Integer)
   If n > UBound(x) Then
      Cells(r, "N").Resize(1, sumx) = v
      r = r + 1
      Exit Sub
   End If
   If x(n, xx) = 0 Or c > x(n, xx) Then
      If xx = 1 Then
         Call com(n, 1, 1, 2)
      Else
         Call com(n + 1, 1, 1, 1)
      End If
      Exit Sub
   End If
   s = 0: If xx = 2 Then s = 3
   yy = 1: If n > 3 Then yy = 2
   For i = k To s + 3 - x(n, xx) + c
      If y(yy, i) > 0 And arr(n, i) Then
         y(yy, i) = y(yy, i) - 1
         m = m + 1
         v(m) = arr(n, i)
         Call com(n, i + 1, c + 1, xx)
         m = m - 1
         y(yy, i) = y(yy, i) + 1
      End If
   Next
End Sub

祝順心，南無阿彌陀佛！

sanpiao

cutecpu 发表于 2021-4-15 23:17
Dim x, y, arr, v, r, m, sumx
Sub demo()
   d1 = Range("u3:z" & .End(xlDown).Row)

感谢老师

sanpiao

老师您看一下图中标有**米楹铣鍪�据，但实现运行后不结果，（我想应该是右面数据按行分别交叉组合）。还有就是如果右面行数不同也能实现组合就太完美了

sanpiao

cutecpu 发表于 2021-4-15 23:17
Dim x, y, arr, v, r, m, sumx
Sub demo()
   d1 = Range("u3:z" & .End(xlDown).Row)

老师您看一下图中标有**米楹铣鍪�据，但实现运行后不结果，（我想应该是右面数据按行分别交叉组合）。还有就是如果右面行数不同也能实现组合就太完美了

sanpiao

cutecpu 发表于 2021-4-15 23:17
Dim x, y, arr, v, r, m, sumx
Sub demo()
   d1 = Range("u3:z" & .End(xlDown).Row)

不知为什么文字出现乱码了，乱码文字是：图中标有颜色的应该组合出数据，但实现运行后不结果

cutecpu

sanpiao 发表于 2021-4-16 12:48
不知为什么文字出现乱码了，乱码文字是：图中标有颜色的应该组合出数据，但实现运行后不结果

行數要一樣才行！

sanpiao

cutecpu 发表于 2021-4-16 13:30
行數要一樣才行！

明白了。老师，那您看一下上面图中的情况为什么不产生结果呢？还有就是右面行数能不能增加一些呢？

cutecpu

sanpiao 发表于 2021-4-16 14:00
明白了。老师，那您看一下上面图中的情况为什么不产生结果呢？还有就是右面行数能不能增加一些呢？

您好，您上傳一下不能產生結果的附件喔，行數您可以自行增加(不限4行)！

sanpiao

cutecpu 发表于 2021-4-16 14:08
您好，您上傳一下不能產生結果的附件喔，行數您可以自行增加(不限4行)！

附件中带黄颜色的

cutecpu

sanpiao 发表于 2021-4-16 14:34
附件中带黄颜色的

祝順心，南無阿彌陀佛！