Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2692|回复: 9

[已解决]用VBA从1——49 这49个数值中随机选出25个数生成不相同的组合

[复制链接]
发表于 2016-1-18 11:24 | 显示全部楼层 |阅读模式
请高手帮忙,要求请看附件。
最佳答案
2016-1-18 13:26
总共有49!/(25!*24!)=63205303218876种(63.2万亿)

用VBA从1——49 中25个数生成不相同的组合.zip

7.77 KB, 下载次数: 7

发表于 2016-1-18 12:31 | 显示全部楼层
49选25,恐怕世上没有一个计算机能够承受起,这个运算量
回复

使用道具 举报

发表于 2016-1-18 13:19 | 显示全部楼层
  1. Sub test()
  2.     Dim arr(1 To 49), brr(1 To 25)
  3.     Dim i%, r%, n&, m%, t%, iNum&
  4.     Dim s1, s2
  5.     For i = 1 To 49
  6.         arr(i) = i
  7.     Next
  8.     iNum = Application.InputBox("49选25抽取数:", "选取", 5, , , , , 1)
  9.     If iNum < 1 Then Exit Sub
  10.     Columns(2).ClearContents
  11.     Randomize
  12.     For n = 1 To iNum
  13.         For i = 1 To 25
  14.             r = Int(Rnd() * (50 - i)) + i
  15.             t = arr(r): arr(r) = arr(i): arr(i) = t
  16.             brr(i) = arr(i)
  17.         Next
  18.         Cells((n + 2) * 2 - 1, 2) = Join(brr, ",")
  19.     Next
  20.     s1 = 1
  21.     For i = 25 To 49
  22.         s1 = s1 * i
  23.     Next
  24.     s2 = 1
  25.     For i = 1 To 25
  26.         s2 = s2 * i
  27.     Next
  28.     MsgBox "49选25共有组合数:" & s1 / s2
  29. End Sub
复制代码
用VBA从1——49 中25个数生成不相同的组合.rar (17.93 KB, 下载次数: 5)
回复

使用道具 举报

发表于 2016-1-18 13:26 | 显示全部楼层    本楼为最佳答案   
总共有49!/(25!*24!)=63205303218876种(63.2万亿)
回复

使用道具 举报

发表于 2016-1-18 14:01 | 显示全部楼层
  1. Sub 从N选m组合()
  2.     Dim N%, m%, L%
  3.     N = 49: m = 25
  4.     ReDim arr(1 To N)
  5.     For i = 1 To N: arr(i) = i: Next
  6.     k = InputBox("请输入所需的组合数", "提示", 10)
  7.     If k < 1 Then Exit Sub
  8.     ReDim crr(1 To 2 * k, 1 To 2)
  9.     Randomize
  10.     For i = 1 To k
  11.         brr = arr
  12.         ReDim xrr(1 To N)            '辅助数组,取出的数按从小到大排序
  13.         L = N
  14.         For j = 1 To m        '数组brr中取m个不重复的随机数
  15.             q = Int(Rnd * L + 1)      '1--L随机数
  16.             xrr(brr(q)) = brr(q)
  17.             brr(q) = brr(L)
  18.             L = L - 1
  19.         Next
  20.         xstr = ""
  21.         For j = 1 To N          '取出的数按从小到大排序放入字符串
  22.             If xrr(j) > 0 Then xstr = xstr & "," & xrr(j)
  23.         Next
  24.         crr(2 * i - 1, 1) = i
  25.         crr(2 * i - 1, 2) = Mid(xstr, 2)
  26.     Next
  27.     [a:b].ClearContents
  28.     [a5].Resize(2 * k, 2) = crr
  29. End Sub
复制代码

用VBA从1——49 中25个数生成不相同的组合.rar

17.73 KB, 下载次数: 6

评分

参与人数 1 +1 收起 理由
pqp888 + 1 很给力

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-1-19 10:56 | 显示全部楼层
grf1973 发表于 2016-1-18 14:01

老师您好:您给做的这个东西不错,但生成的每组中的最后一个数要以“,”豆号结尾才行,不知可否改改。
回复

使用道具 举报

发表于 2016-1-19 14:26 | 显示全部楼层
调整了grf1973老师的代码,就可以满足你的要求了
  1. Sub 从N选m组合_修改()
  2.     Dim N%, m%, L%
  3.     N = 49: m = 25
  4.     ReDim arr(1 To N)
  5.     For i = 1 To N: arr(i) = i: Next
  6.     k = InputBox("请输入所需的组合数", "提示", 10)
  7.     If k < 1 Then Exit Sub
  8.     ReDim crr(1 To 2 * k, 1 To 2)
  9.     Randomize
  10.     For i = 1 To k
  11.         brr = arr
  12.         ReDim xrr(1 To N)            '辅助数组,取出的数按从小到大排序
  13.         L = N
  14.         For j = 1 To m        '数组brr中取m个不重复的随机数
  15.             q = Int(Rnd * L + 1)      '1--L随机数
  16.             xrr(brr(q)) = brr(q)
  17.             brr(q) = brr(L)
  18.             L = L - 1
  19.         Next
  20.         xstr = ""
  21.         For j = 1 To N          '取出的数按从小到大排序放入字符串
  22.             If xrr(j) > 0 Then xstr = xstr & xrr(j) & ","
  23.         Next
  24.         crr(2 * i - 1, 1) = i
  25.         crr(2 * i - 1, 2) = xstr
  26.     Next
  27.     [a:b].ClearContents
  28.     [a5].Resize(2 * k, 2) = crr
  29. End Sub
复制代码

用VBA从1——49 中25个数生成不相同的组合.rar

18.52 KB, 下载次数: 10

评分

参与人数 1 +1 收起 理由
pqp888 + 1 赞一个

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-1-19 14:33 | 显示全部楼层
sry660 发表于 2016-1-19 14:26
调整了grf1973老师的代码,就可以满足你的要求了

谢谢!
回复

使用道具 举报

发表于 2016-1-20 09:30 | 显示全部楼层
pqp888 发表于 2016-1-19 10:56
老师您好:您给做的这个东西不错,但生成的每组中的最后一个数要以“,”豆号结尾才行,不知可否改改。

这要求相当奇葩,我还特地考虑去掉头尾的逗号的,看来是多此一举了。
回复

使用道具 举报

 楼主| 发表于 2016-1-20 10:23 | 显示全部楼层
grf1973 发表于 2016-1-20 09:30
这要求相当奇葩,我还特地考虑去掉头尾的逗号的,看来是多此一举了。

不好意思,辛苦您了,谢谢。逗号是要分隔开两个数,要不查找识别不出。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 04:41 , Processed in 0.918912 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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