ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南

[求助] 多条件排列组合

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-7 11:13 | 显示全部楼层
最小值与最大值有可能是一个数字(同一个数)。

TA的精华主题

TA的得分主题

发表于 2016-1-7 12:16 | 显示全部楼层
这么简单,就不会自己弄一下么。

CombinTest-3.zip

21.89 KB, 下载次数: 65

评分

参与人数 1鲜花 +2 收起 理由
学不完用不尽 + 2 无以表达,鲜花两朵,以资鼓励。

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-7 13:57 | 显示全部楼层
香川群子 发表于 2016-1-7 12:16
这么简单,就不会自己弄一下么。

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-7 23:32 | 显示全部楼层
香川群子 发表于 2016-1-7 12:16
这么简单,就不会自己弄一下么。

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

TA的精华主题

TA的得分主题

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

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

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

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

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-8 14:17 | 显示全部楼层
本帖最后由 学不完用不尽 于 2016-1-8 14:58 编辑
香川群子 发表于 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, 下载次数: 39)

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-9 14:49 | 显示全部楼层
香川群子 发表于 2016-1-8 11:35
你现在的要求,和一开始的做法已经有很大不同。

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-1-10 20:12 | 显示全部楼层
香川群子 发表于 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. Sub dgMN1(r&, j&) '1序列不重复组合
  58.     Dim h&, i&, L&, s&, t&
  59.     For i = 1 To UBound(sj)
  60.         t = sj(i, j): If sj(i, j) = "" Then Exit For
  61.         If t > jg(k, j - 1) Then
  62.             jg(k, j) = t
  63.             If j = n Then
  64.                 s = 0: ReDim b&(9)
  65.                 For L = 1 To n
  66.                     h = jg(k, L) Mod 10: If b(h) = 0 Then b(h) = 1: s = s + 1
  67.                 Next
  68.                 If s = m Then
  69.                     h = r + t
  70.                     ism(k + 1) = h
  71.                     If h >= h1 Then
  72.                         If h <= h2 Then
  73.                             jg(k, n + 1) = h: k = k + 1: jg(k - 1, 0) = k
  74.                             For L = 1 To n - 1
  75.                                 jg(k, L) = jg(k - 1, L)
  76.                             Next
  77.                         End If
  78.                     End If
  79.                 End If
  80.             Else
  81.                 Call dgMN1(r + t, j + 1)
  82.             End If
  83.         End If
  84.     Next
  85. End Sub
  86. Sub dgMN0(r&, j&) '0序列允许重复组合
  87.     Dim h&, i&, L&, s&, t&
  88.     For i = 1 To UBound(sj)
  89.         t = sj(i, j): If sj(i, j) = "" Then Exit For
  90.         If t >= jg(k, j - 1) Then
  91.             jg(k, j) = t
  92.             If j = n Then
  93.                 s = 0: ReDim b&(9)
  94.                 For L = 1 To n
  95.                     h = jg(k, L) Mod 10: If b(h) = 0 Then b(h) = 1: s = s + 1
  96.                 Next
  97.                 If s = m Then
  98.                     h = r + t
  99.                     ism(k + 1) = h
  100.                     If h >= h1 Then
  101.                         If h <= h2 Then
  102.                             jg(k, n + 1) = h: k = k + 1: jg(k - 1, 0) = k
  103.                             For L = 1 To n - 1
  104.                                 jg(k, L) = jg(k - 1, L)
  105.                             Next
  106.                         End If
  107.                     End If
  108.                 End If
  109.             Else
  110.                 Call dgMN0(r + t, j + 1)
  111.             End If
  112.         End If
  113.     Next
  114. End Sub
复制代码
香川多列组合尾数及和值.rar (22.06 KB, 下载次数: 47)

TA的精华主题

TA的得分主题

发表于 2016-1-10 23:09 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-1-11 03:45 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-21 10:56 , Processed in 0.101651 second(s), 19 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表