多条件排列组合

学不完用不尽

最小值与最大值有可能是一个数字（同一个数）。

香川群子

这么简单，就不会自己弄一下么。

学不完用不尽

香川群子 发表于 2016-1-7 12:16
这么简单，就不会自己弄一下么。

辛苦啦，谢谢！
这么简单？一般人写不出这么精炼的代码。
程序OK!!

学不完用不尽

香川群子 发表于 2016-1-7 12:16
这么简单，就不会自己弄一下么。

女侠，还需你援助，本想把此代码修改成通用的，无奈，越改越不敌。
要求：数据区可以输入任意数字。
请女侠圈阅斧正，谢谢！
和值排列组合通用.rar (21.92 KB, 下载次数: 33)

2016-1-7 23:32 上传

点击文件名下载附件

香川群子

学不完用不尽 发表于 2016-1-7 23:32
女侠，还需你援助，本想把此代码修改成通用的，无奈，越改越不敌。
要求：数据区可以输入任意数字。
请 ...

你现在的要求，和一开始的做法已经有很大不同。

1. 数据区原来是很有规律的数，现在是任意数值了吗？
有没有明确的数值范围，如 1-36 或 0-9 或没有范围？

2. 得到的组合，有没有限制重复数出现的要求？ 如： 1111111 是有效还是无效？
    同样，是否必须满足升序要求？ 如： 1239761 是有效还是无效？

3. 和值范围可以理解，但尾数和值范围时什么意思？如何计算得到？

以上问题并不明确，所以无法代码。

学不完用不尽

香川群子 发表于 2016-1-8 11:35
你现在的要求，和一开始的做法已经有很大不同。

1. 数据区原来是很有规律的数，现在是任意数值了吗？
...

谢谢香川大师！
1、也算有规律。数值可以分两种：（1）0~9序列，即每列都是从0到9排列；（2）1~100序列，这个可以是任意数值，每列数值或多或少，没有明确的数值范围，原则上无规律，但无重复数值，均是从小到大顺序排列的。
2、如果是0~9（数值中含0的序列）序列，允许重复数出现，不限制升序要求；如果是从1~100（数值中不含0的序列）开始的不允许重复数出现，要求升序排列。这两种序列输出的有效组合中不能有重复组合（数值、位置都一样属于重复）。
3、尾数和值范围指的是：判断设置的和值范围前而得到的组合的和值，也就是根据尾数先得到的有效组合和值中的最值，目的主要是为了判断设置的和值范围是不是在有效组合和值之内，如果不在有效组合和值之内，需重新设置和值范围，避免无有效组合。
如果我理解不错的话，程序运行时应该得到两组组合：（1）一组是按尾数先进行组合，（2）最后输出的有效组合是按和值筛选后的有效组合。（1）的组合大于（2）的有效组合，尾数和值范围指的就是（1）组合和值中的最值。

和值排列组合通用.rar (22.52 KB, 下载次数: 51)

2016-1-8 14:58 上传

点击文件名下载附件

学不完用不尽

香川群子 发表于 2016-1-8 11:35
你现在的要求，和一开始的做法已经有很大不同。

1. 数据区原来是很有规律的数，现在是任意数值了吗？
...

输入任意数值，都能得到符合条件的有效组合，这就是最终目的。
谢谢香川侠女!

学不完用不尽

香川群子 发表于 2016-1-8 11:35
你现在的要求，和一开始的做法已经有很大不同。

1. 数据区原来是很有规律的数，现在是任意数值了吗？
...

班门弄斧，胡乱堆放，请香川侠女雅正，谢谢！

1. Option Explicit
   
2. Dim sj, jg(), ism, h1&, h2&, m&, n&, k&
   
3. Sub test() 'by kagawa 2106/1/5-1/7
   
4.     Dim a&(9), sj1, sj2, sj01, i&, j&, L&, cl&, r&, t&, tms#
   
5.     Dim imn, imx
   
6.     tms = Timer
   
7.     m = [a1].End(4).Row - 1 '尾数行
   
8.     For i = 1 To m
   
9.         a(Cells(i + 1, 1)) = 1 '提取尾数
   
10.     Next
    
11.     cl = [a1].End(2).Column '数值列
    
12.     n = WorksheetFunction.Sum([b1].Resize(, cl - 1)) '抽取个数和
    
13. '    If n <> 5 Then MsgBox "n <> 5 Err !": Exit Sub
    
14.     sj1 = [a1].CurrentRegion
    
15.     r = UBound(sj1) - 1
    
16.     ReDim sj2(1 To r, 1 To n) '声明要存放排列组合数值的数组
    
17.     n = 0: r = 1
    
18.     For j = 2 To cl
    
19.         For L = 1 To sj1(1, j)
    
20.             n = n + 1: i = 0
    
21.             For k = 2 To UBound(sj1) '遍历数值
    
22.                If sj1(k, j) <> "" Then
    
23.                If sj1(k, j) = 0 Then sj01 = sj01 + 1 '判断0序列
    
24.                t = sj1(k, j)
    
25.                If a(t Mod 10) Then i = i + 1: sj2(i, n) = t '提取符合尾数条件的数值
    
26.                End If
    
27.             Next
    
28.             r = r * i '组合总数
    
29.         Next
    
30.     Next
    
31.     [b20].CurrentRegion = ""
    
32.     [b20].Resize(UBound(sj2), n) = sj2 '将符合尾数条件的数值写入单元格
    
33.     sj = [b20].CurrentRegion '将符合尾数条件的数值赋值给数组
    
34.     ReDim jg(r, n + 1) '声明存放组合结果的数组
    
35.     If r > 100000 Then ReDim ism(1 To r \ 10) Else ReDim ism(1 To r \ 2) '声明并缩小存放组合和值数组，避开空值，避免类型不匹配现象
    
36.     h1 = Range("l3") '设置最小和值
    
37.     h2 = Range("m3") '设置最大和值
    
38.     If sj01 > 0 Then '判断组合数值是0序列还是1序列（0序列：0~9，每列都是0~9；1序列：1~100，从1开始由小到大不重复输入）
    
39.        k = 0: Call dgMN0(0, 1)
    
40.     Else
    
41.        k = 0: Call dgMN1(0, 1)
    
42.     End If
    
43.     imn = Application.Min(ism) '组合最小值
    
44.     imx = Application.Max(ism) '组合最大值
    
45.     Range("l7:m7") = ""
    
46.     Range("l7:m7") = Array(imn, imx)
    
47.     If imx < h1 Then MsgBox "和值筛选范围错误！"
    
48.     [o1].CurrentRegion = ""
    
49.     For L = 1 To n
    
50.         Cells(1, L + 15) = L '结果表头
    
51.     Next
    
52.     [o1] = "NO:" & k
    
53.     [o1].Offset(, n + 1) = "和值"
    
54.     If k Then [o2].Resize(k, 2 + n) = jg
    
55.     MsgBox Format(Timer - tms, "0.000s ") & k
    
56. End Sub
    
57. 
    
58. Sub dgMN1(r&, j&) '1序列不重复组合
    
59.     Dim h&, i&, L&, s&, t&
    
60.     For i = 1 To UBound(sj)
    
61.         t = sj(i, j): If sj(i, j) = "" Then Exit For
    
62.         If t > jg(k, j - 1) Then
    
63.             jg(k, j) = t
    
64.             If j = n Then
    
65.                 s = 0: ReDim b&(9)
    
66.                 For L = 1 To n
    
67.                     h = jg(k, L) Mod 10: If b(h) = 0 Then b(h) = 1: s = s + 1
    
68.                 Next
    
69.                 If s = m Then
    
70.                     h = r + t
    
71.                     ism(k + 1) = h
    
72.                     If h >= h1 Then
    
73.                         If h <= h2 Then
    
74.                             jg(k, n + 1) = h: k = k + 1: jg(k - 1, 0) = k
    
75.                             For L = 1 To n - 1
    
76.                                 jg(k, L) = jg(k - 1, L)
    
77.                             Next
    
78.                         End If
    
79.                     End If
    
80.                 End If
    
81.             Else
    
82.                 Call dgMN1(r + t, j + 1)
    
83.             End If
    
84.         End If
    
85.     Next
    
86. End Sub
    
87. Sub dgMN0(r&, j&) '0序列允许重复组合
    
88.     Dim h&, i&, L&, s&, t&
    
89.     For i = 1 To UBound(sj)
    
90.         t = sj(i, j): If sj(i, j) = "" Then Exit For
    
91.         If t >= jg(k, j - 1) Then
    
92.             jg(k, j) = t
    
93.             If j = n Then
    
94.                 s = 0: ReDim b&(9)
    
95.                 For L = 1 To n
    
96.                     h = jg(k, L) Mod 10: If b(h) = 0 Then b(h) = 1: s = s + 1
    
97.                 Next
    
98.                 If s = m Then
    
99.                     h = r + t
    
100.                     ism(k + 1) = h
     
101.                     If h >= h1 Then
     
102.                         If h <= h2 Then
     
103.                             jg(k, n + 1) = h: k = k + 1: jg(k - 1, 0) = k
     
104.                             For L = 1 To n - 1
     
105.                                 jg(k, L) = jg(k - 1, L)
     
106.                             Next
     
107.                         End If
     
108.                     End If
     
109.                 End If
     
110.             Else
     
111.                 Call dgMN0(r + t, j + 1)
     
112.             End If
     
113.         End If
     
114.     Next
     
115. End Sub
     

复制代码

香川多列组合尾数及和值.rar (22.06 KB, 下载次数: 58)

2016-1-10 20:12 上传

点击文件名下载附件

春播秋收

这个对我有帮助,谢谢.

ss268

好，这个对我有帮助,谢谢.