（求助VBA）复杂的条件组合

三票

蓝桥玄霜 发表于 2024-6-12 15:17
请见附件。

感谢蓝版主，还有点小问题：如果组合个数改变也能组合出对应个的结果就可以了

三票

蓝桥玄霜 发表于 2024-6-12 15:17
请见附件。

组合个数改成范围比如3～4这样

三票

蓝桥玄霜 发表于 2024-6-12 15:17
请见附件。

肯请蓝版主有时间做下修改：组合个数改成范围比如3～4这样

三票

蓝桥玄霜 发表于 2024-6-12 15:17
请见附件。

组合个数改成范围比如3～4

grf1973

终于把JSA改成VBA了，那段递归用VBA真是不好写。

1. Dim res(), s, data()
   
2. Sub main_VBA()
   
3.     data = Application.Transpose(Range("c4:c83"))
   
4.     Range("T11:V1000").ClearContents
   
5. 
   
6.     a = 5: b = 4: c = "9~11": d = "3~5": e = "2~3"
   
7.     fr1 = 筛选(a, b, c, d, e)
   
8.     Range("t11").Resize(UBound(fr1)) = Application.Transpose(fr1)
   
9.    
   
10.     a = 6: b = 3: c = "10~18": d = "2~5": e = "2~3"
    
11.     fr2 = 筛选(a, b, c, d, e)
    
12.     Range("U11").Resize(UBound(fr2)) = Application.Transpose(fr2)
    
13.    
    
14.     a = 3: b = 3: c = "14~24": d = "2~5": e = "0~0"
    
15.     fr3 = 筛选(a, b, c, d, e)
    
16.     Range("V11").Resize(UBound(fr3)) = Application.Transpose(fr3)
    
17.    
    
18.     ReDim frs(1 To UBound(fr1) * UBound(fr2) * UBound(fr3), 1 To 1)
    
19.     For Each x1 In fr1   '//符合条件的三个数组相合
    
20.         For Each x2 In fr2
    
21.             For Each x3 In fr3
    
22.                 i = i + 1
    
23.                 frs(i, 1) = x1 & "," & x2 & "," & x3
    
24.     Next x3, x2, x1
    
25.     Range("W11").Resize(UBound(frs)) = frs
    
26. End Sub
    
27. Function 筛选(a, b, c, d, e) '5个条件进行筛选
    
28.     For i = 1 To UBound(data)
    
29.         x = Val(data(i))
    
30.         If x \ 10 = a Then ss = ss & "," & data(i)
    
31.     Next
    
32.     nums = Split(Mid(ss, 2), ",")
    
33.     s = 0
    
34.     n = b
    
35.     ReDim res(1 To UBound(nums) ^ n)
    
36.     crr = Split(c, "~"): c1 = crr(0): c2 = crr(1)
    
37.     drr = Split(d, "~"): d1 = drr(0): d2 = drr(1)
    
38.     eerr = Split(e, "~"): e1 = eerr(0): e2 = eerr(1)
    
39.    
    
40.     Call dg(nums, n, "") '//生成res
    
41.     ReDim finalres(1 To UBound(res))
    
42.     For Each xx In res
    
43.         x = Split(Mid(xx, 2), ",")
    
44.         If test1(x, c1, c2) And test2(x, d1, d2) And test3(x, e1, e2) Then
    
45.             k = k + 1
    
46.             finalres(k) = Mid(xx, 2)
    
47.         End If
    
48.     Next
    
49.     ReDim f(1 To k)
    
50.     For i = 1 To k
    
51.         f(i) = finalres(i)
    
52.     Next
    
53.     筛选 = f
    
54. End Function
    
55. 
    
56. Sub dg(nums, n, path) '递归生成,path=",1,2,3,4"样式，存入Res
    
57.     If Len(path) - Len(Replace(path, ",", "")) = n Then
    
58.         s = s + 1
    
59.         res(s) = path
    
60.         Exit Sub
    
61.     End If
    
62.     c = UBound(nums)
    
63.     For i = 0 To c
    
64.         x = nums(i)
    
65.         If Len(x) = 0 Then Exit Sub
    
66.         ReDim restnums(0 To c - i)
    
67.         For j = i + 1 To UBound(nums)
    
68.             restnums(j - i - 1) = nums(j)
    
69.         Next
    
70.         nextpath = path & "," & x
    
71.         Call dg(restnums, n, nextpath)
    
72.     Next
    
73. End Sub
    
74. 
    
75. Function test1(arr, t1, t2) As Boolean  '组合结果个位数字和值是否在t1,t2之间
    
76.     If t1 = "" And t2 = "" Then test1 = True: Exit Function
    
77.     For Each x In arr
    
78.         n = n + Val(x) Mod 10
    
79.     Next
    
80.     If n >= Val(t1) And n <= Val(t2) Then test1 = True
    
81. End Function
    
82.    
    
83. Function test2(arr, t1, t2) As Boolean '组合结果个位数字跨度是否在t1,t2之间
    
84.     imax = 0: imin = 9
    
85.     If t1 = "" And t2 = "" Then test2 = True: Exit Function
    
86.     For Each x In arr
    
87.         t = Val(x) Mod 10
    
88.         If imax < t Then imax = t
    
89.         If imin > t Then imin = t
    
90.     Next
    
91.     n = imax - imin
    
92.     If n >= Val(t1) And n <= Val(t2) Then test2 = True
    
93. End Function
    
94. 
    
95. Function test3(arr, t1, t2) As Boolean '个位质数个数是否在t1,t2之间
    
96.     If t1 = "" And t2 = "" Then test3 = True: Exit Function
    
97.     For Each x In arr
    
98.         t = Val(x) Mod 10
    
99.         If t = 1 Or t = 2 Or t = 3 Or t = 5 Or t = 7 Then n = n + 1
    
100.     Next
     
101.     If n >= Val(t1) And n <= Val(t2) Then test3 = True
     
102. End Function
     

复制代码

grf1973

VBA也做了一个。。。。。。。