ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 10091|回复: 31

[原创] 聊一聊不重复排列组合的PQ、函数、VBA、Python等常用解法~

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2021-11-26 09:46 | 显示全部楼层 |阅读模式
本帖最后由 看见星光 于 2021-11-26 09:55 编辑

不重复排列组合的问题是指从给定个数的元素集中取出指定个数的元素进行排列,同时要求取出的元素不重复。在日常工作中,常用于凑数、排班、不重复组合抽样等等。


举个例子。


1.png


如上图所示,假设A列有5个人名,现在需要从中抽取4个不重复的人去搬砖,请问一共有多少种组合?并在D:G列计算出明细。


给大家分享几种常用解法,包含了函数、PQ、VBA和Python等。


PowerQuery解:
  1. let//by看见星光
  2.     源 =Table.ToColumns(Excel.CurrentWorkbook(){[Name="表1"]}[Content]){0},
  3.     m=4,y=List.Count(源)-1,//m是需要抽取的个数
  4.     fx=(x,n,lst)=>//索引,数量,结果
  5.         if n=m then {lst} else List.Accumulate({x..y-(m-n)+1},{},(s,d)=>s & @fx(d+1,n+1,lst & {源{d}})),
  6.     结果=Table.FromRows(fx(0,0,{}))
  7. in
  8.     结果
复制代码


函数解:
  1. =INDEX($A:$A,SMALL(MID(BASE(LARGE(IF(LEN(SUBSTITUTE(BASE(ROW($1:$31),2,5),"0",))=4,ROW($1:$31)),ROW(A1)),2,5),ROW($1:$5),1)*ROW($2:$6),COLUMN(B1)))
复制代码


VBA解:

对于Excel来说,解决这类问题使用频次最高、效率最高的还是VBA。提供三种参考解法,辅助数组解、二进制解和递归解。

1)递归回溯:
  1. Dim aData, aRes, m&, n&, k&
  2. Sub cb() '递归
  3.     aData = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
  4.     k = 0: m = UBound(aData): n = 4 '一共几个元素和取几个元素
  5.     ReDim aRes(1 To Application.Combin(m, n), 1 To n)
  6.     Call fx(1, 0, "")
  7.     Range("d2").Resize(k, UBound(aRes, 2)) = aRes
  8.     MsgBox "ok"
  9. End Sub

  10. Function fx(x, y, s) '索引,组合个数,组合结果
  11.     Dim i&, j&, t
  12.     If y = n Then '如果组合项个数等于目标
  13.         k = k + 1: j = 0
  14.         For Each t In Split(Mid(s, 2), ",") '取结果
  15.             j = j + 1
  16.             aRes(k, j) = t
  17.         Next
  18.         Exit Function
  19.     End If
  20.     For i = x To m - (n - y) + 1 '剪枝
  21.         Call fx(i + 1, y + 1, s & "," & aData(i, 1)) '回溯
  22.     Next
  23. End Function
复制代码

2)二进制:

  1. Sub cbb() '二进制
  2.     Dim aData, aRes, i&, j&, k&, m&, y&, g&, s$, t$, n&
  3.     aData = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
  4.     m = 4: y = UBound(aData)
  5.     ReDim aRes(1 To Application.Combin(UBound(aData), m), 1 To m) '目标组合结果的个数
  6.     g = Evaluate("sum(combin(" & y & ",row(1:" & y & ")))") '所有组合的个数
  7.     For i = 1 To g
  8.         s = Application.Base(i, 2, y) '转二进制
  9.         t = Replace(s, "0", "")
  10.         If Len(t) = m Then '如果组合项个数等于目标
  11.             k = k + 1 '计数器
  12.             n = 0
  13.             For j = 1 To y '遍历二进制字符
  14.                 If Mid(s, j, 1) = "1" Then
  15.                     n = n + 1
  16.                     aRes(k, n) = aData(j, 1)
  17.                 End If
  18.             Next
  19.         End If
  20.     Next
  21.     Range("d2").Resize(k, UBound(aRes, 2)) = aRes
  22.     MsgBox "ok"
  23. End Sub
复制代码

3)辅助数组:
  1. Sub cbr() '辅助数组
  2.     Dim aData, aRes, aRef, i&, m&, j&, k&, r, x&, n&
  3.     aData = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
  4.     m = 4 '取几个
  5.     ReDim aRes(1 To Application.Combin(UBound(aData), m), 1 To m) '组合结果的个数
  6.     ReDim aRef(0 To Application.Combina(5, 4), 1 To 2) '辅助数组
  7.     For i = 1 To UBound(aData) '遍历数据源
  8.         For j = 0 To k '通过辅助数组进行组合
  9.             k = k + 1
  10.             aRef(k, 1) = aRef(j, 1) & "," & aData(i, 1) '组合
  11.             aRef(k, 2) = aRef(j, 2) + 1 '项数
  12.             If aRef(k, 2) = m Then '如果组合项有m个
  13.                 n = n + 1
  14.                 r = Split(aRef(k, 1), ",") '取出装入结果数组
  15.                 For x = 1 To m
  16.                     aRes(n, x) = r(x)
  17.                 Next
  18.             End If
  19.         Next
  20.     Next
  21.     Range("d2").Resize(n, UBound(aRes, 2)) = aRes
  22.     MsgBox "ok"
  23. End Sub
复制代码


Python解

最后说一下Python解。

最近总有朋友来询问学Python还是VBA?我的观点是:如果你是从事数据分析或者有意转岗数据分析的话,Python必会;如果你不是做数据分析的,只是正经的办公人员,日常处理的数据范畴并没有超过Office,那就选择VBA——Python学了仨月,用不上的话,俩周你就忘光了。

我倒不是说Python不强,它比VBA强多了。但这就好比你出门去马路对面的商店买东西,500米的距离,你是选择走路呢?还是开汽车呢?走路就是VBA,汽车就是Python,就这么回事。

VBA的解法思路Python都可以实现,比如递归:
  1. def combine(r: list, k: int) :
  2.     res=[]  #最终结果
  3.     path=[]  #条件结果
  4.     def backtrack(n, startIndex):
  5.         if len(path) == k:
  6.             res.append(path[:])#深度copy
  7.             return #出口
  8.         for i in range(startIndex,n-(k-len(path))+1):
  9.             path.append(r[i])  #处理节点
  10.             backtrack(n,i+1)  #递归
  11.             path.pop()  #回溯并撤销处理过的节点
  12.     backtrack(len(r),0)
  13.     return res
  14. combine (['看见星光','公众号Excel星球','excel','ppt','word'],4)
复制代码

除此之外,Python还可以调库:

  1. from itertools import combinations
  2. name=['看见星光','公众号Excel星球','excel','ppt','word']
  3. res=[s for s in combinations(name,4)]
复制代码

……

案例文件下载:

4001-M选N的组合.rar (391.96 KB, 下载次数: 114)


评分

19

查看全部评分

TA的精华主题

TA的得分主题

发表于 2021-11-26 10:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
学到了,代码简洁明了,星光老师每次分享都能学到很多闪光点

TA的精华主题

TA的得分主题

发表于 2021-11-26 10:43 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
谢谢星光老师的分享!

TA的精华主题

TA的得分主题

发表于 2021-11-26 14:12 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-26 14:14 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-26 14:17 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-26 15:05 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-26 15:06 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
学习了!!!!

TA的精华主题

TA的得分主题

发表于 2021-11-26 17:19 来自手机 | 显示全部楼层
select * from 求组合明细表;with aa as (select * from 求组合明细表),bb as (select * from 求组合明细表 where number in (1,10,100,1000)),cc as (select * from 求组合明细表 where number in (1,10,100)),dd as (select * from 求组合明细表 where number in (1,10)),ee as (select aa.number as 项1id,bb.number 项2id,cc.number 项3id,dd.number 项4id,aa.第一列 项1,bb.第一列 项2,cc.第一列 项3,dd.第一列 项4,(aa.number+bb.number+cc.number+dd.number) key from aa,bb,cc,dd)select row_number() over () 组合,项1,项2,项3,项4 from ee where not regexp('[^01]',key) group by key
学习了,再来一个用sql方法
Screenshot_2021-11-26-17-16-32-496_com.chrome.dev.jpg

TA的精华主题

TA的得分主题

发表于 2021-11-27 10:17 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-21 18:54 , Processed in 0.048715 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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