有点难度的不确定数据组合

jz_l

gfdhgw

jz_l 发表于 2023-7-20 16:23

老师厉害,谢谢了

gfdhgw

tomxie 发表于 2023-7-20 16:51
SQL稍加精简，1句分为17行，上面的 VBA的好像超过150+行。

这个也很好,但是没办法直接在表格中应用,可惜了

wodewan

jz_l 发表于 2023-7-20 16:23

老大，用WPS的JSA瞎写了一个整体比VBA快一倍，数据没你快，标色比你快，哈哈

gfdhgw

wodewan 发表于 2023-7-20 18:21
老大，用WPS的JSA瞎写了一个整体比VBA快一倍，数据没你快，标色比你快，哈哈

也不错,谢谢

micch

直接递归，实在是太费脑子了，因为已知4列，干脆就直接写循环了。每一列的数量不固定，这个没办法只能递归取数，完了就是纯循环。

1. 
   
2. Sub Main()
   
3.     tt = Timer
   
4.     ar = Range("a1:d8").Value
   
5.     br = Range("f2:h5").Value
   
6.     n = Range("i2").Value
   
7.     ReDim cr(1 To 4)
   
8.     For i = 1 To 4
   
9.         cr(i) = GetNumofColumn(ar, i)
   
10.     Next
    
11.     ar = cr
    
12.     ReDim result(1 To 50000, 1 To n)
    
13.    
    
14.     For i1 = br(1, 2) To br(1, 3)
    
15.     For i2 = br(2, 2) To br(2, 3)
    
16.     For i3 = br(3, 2) To br(3, 3)
    
17.     For i4 = br(4, 2) To br(4, 3)
    
18.             If i1 + i2 + i3 + i4 = n Then
    
19.                 j = 0
    
20.                 If i1 > 0 Then j = j + 1: cr(j) = CombinM_N(ar(1), i1)
    
21.                 If i2 > 0 Then j = j + 1: cr(j) = CombinM_N(ar(2), i2)
    
22.                 If i3 > 0 Then j = j + 1: cr(j) = CombinM_N(ar(3), i3)
    
23.                 If i4 > 0 Then j = j + 1: cr(j) = CombinM_N(ar(4), i4)
    
24.                 If j < 4 Then
    
25.                     ReDim temp(1, 1)
    
26.                     For i = j + 1 To 4
    
27.                         cr(i) = temp
    
28.                     Next
    
29.                 End If
    
30.                     For j1 = 1 To UBound(cr(1))
    
31.                     For j2 = 1 To UBound(cr(2))
    
32.                     For j3 = 1 To UBound(cr(3))
    
33.                     For j4 = 1 To UBound(cr(4))
    
34.                         k = k + 1
    
35.                         For k1 = 1 To UBound(cr(1), 2)
    
36.                             If k1 <= n Then result(k, k1) = cr(1)(j1, k1)
    
37.                         Next
    
38.                         For k2 = 1 To UBound(cr(2), 2)
    
39.                             If k1 - 1 + k2 <= n Then result(k, k1 - 1 + k2) = cr(2)(j2, k2)
    
40.                         Next
    
41.                         For k3 = 1 To UBound(cr(3), 2)
    
42.                             If k1 + k2 - 2 + k3 <= n Then result(k, k1 + k2 - 2 + k3) = cr(3)(j3, k3)
    
43.                         Next
    
44.                         For k4 = 1 To UBound(cr(4), 2)
    
45.                             If k1 + k2 + k3 - 3 + k4 <= n Then result(k, k1 + k2 + k3 - 3 + k4) = cr(4)(j4, k4)
    
46.                         Next
    
47.                     Next
    
48.                     Next
    
49.                     Next
    
50.                     Next
    
51.             End If
    
52.     Next
    
53.     Next
    
54.     Next
    
55.     Next
    
56.     Range("k1").Resize(k, n).Value = result
    
57.     MsgBox "组合数量： " & k & Chr(10) & "用时： " & Timer - tt
    
58. End Sub
    
59. 
    
60. Function GetNumofColumn(ar, ByVal c)
    
61.     Dim br()
    
62.     ReDim br(1 To 1)
    
63.     For i = 2 To UBound(ar)
    
64.         If Len(ar(i, c)) = 0 Then
    
65.         Exit For
    
66.         Else
    
67.         j = j + 1
    
68.         ReDim Preserve br(1 To j)
    
69.         br(j) = ar(1, c) & ar(i, c)
    
70.         End If
    
71.     Next
    
72.     GetNumofColumn = br
    
73. End Function
    
74. 
    
75. Function CombinM_N(ar0, n0)
    
76.     Dim k&, a&(), result(), m0&
    
77.     If n0 > 0 Then
    
78.     m0 = UBound(ar0)
    
79.     k = Application.WorksheetFunction.Combin(m0, n0)
    
80.     ReDim result(1 To k, 1 To n0)
    
81.     k = 0
    
82.     ReDim a(1 To n0)
    
83.     Call DG(a, 0, 1, ar0, result, m0, n0, k)
    
84.     Else
    
85.     ReDim result(0, 0)
    
86.     End If
    
87.     CombinM_N = result
    
88. End Function
    
89. Sub DG(a&(), i&, t&, ar0, result, m, n, k)
    
90.     Dim j&, l&
    
91.     For j = i + 1 To m - n + t
    
92.     a(t) = j
    
93.     If t = n Then
    
94.     k = k + 1
    
95.     For l = 1 To n
    
96.     result(k, l) = ar0(a(l))
    
97.     Next
    
98.     Else
    
99.     Call DG(a, j, t + 1, ar0, result, m, n, k)
    
100.     End If
     
101.     Next
     
102. End Sub
     
103. 
     
104. 
     

复制代码

gfdhgw

wodewan 发表于 2023-7-20 18:21
老大，用WPS的JSA瞎写了一个整体比VBA快一倍，数据没你快，标色比你快，哈哈

你好,你这个好像没有对同一组合内的数字排序后输出,如果第一列的数字比后面的大,输出就不是依次从小到大的顺序了,要在哪行加什么语句?

gfdhgw

jz_l 发表于 2023-7-20 16:23

你好,老师,这个好像没有对组合后的数字排序输出,如果第一列的数字比后面的大,输出就不是依次从小到大的顺序了,要在哪行加什么语句?

micch

加一个组合内部排序

gfdhgw

micch 发表于 2023-7-20 22:38
加一个组合内部排序

你好,这个组合内部排序的代码是什么?谢谢