ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求10选5的万能8码,参考下方的11选5万能八码,代码修改一下

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-12-13 13:56 | 显示全部楼层 |阅读模式
本帖最后由 gaoch35 于 2018-12-14 14:59 编辑

附件有代码

新建 Microsoft Office Excel 工作表.zip

9.39 KB, 下载次数: 124

TA的精华主题

TA的得分主题

发表于 2019-3-11 10:12 | 显示全部楼层
香川群子 发表于 2018-12-21 13:25
10选5的万能8码,随机计算最优解是8组。

老师:15选5万能9码最优解是几组?求解。谢谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-21 20:57 | 显示全部楼层
香川群子 发表于 2018-12-21 16:38
最少应该是8组。

有很多解:

香川老师24楼的代码怎么改,我一改就提示有错误,改哪里怎么改,麻烦把修改后的代码全部上传

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-21 20:50 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-21 20:48 | 显示全部楼层
香川群子 发表于 2018-12-21 16:38
最少应该是8组。

有很多解:

香川老师你给出的是10选8的8码解码?怎么有15,19,20...这样啊

TA的精华主题

TA的得分主题

发表于 2018-12-21 16:51 | 显示全部楼层
按序号展开如:
1        2        3        4        5        6        7        9        2
1        2        3        4        6        7        8        9        21
1        2        3        4        7        9        10        11        34
1        2        3        5        6        8        9        10        42
1        2        3        5        6        8        9        11        43
1        2        4        5        7        8        10        11        69
1        2        4        6        7        9        10        11        75
1        3        4        5        7        8        10        11        97
1        3        4        6        7        9        10        11        103
1        4        5        6        7        8        10        11        115
1        4        5        7        8        9        10        11        118
2        3        4        5        6        7        9        11        125
2        3        4        5        6        8        9        10        127
2        3        4        6        7        8        9        11        137
2        3        5        6        7        8        9        10        142
2        3        5        6        8        9        10        11        146

TA的精华主题

TA的得分主题

发表于 2018-12-21 16:44 | 显示全部楼层
zopey 发表于 2018-12-17 11:38
11选5:
1,2,3,4,5,6,7,8
1,2,3,4,5,6,7,9

11选5的万能8码,16组大概率是最优解了。

给你看6组:
1        1        1        3        1        16
5        11        20        21        8        28
6        12        21        25        9        41
7        13        22        41        15        46
34        30        23        42        16        60
49        54        42        52        17        61
84        59        43        59        18        69
105        63        49        60        54        75
109        71        55        74        55        80
111        110        73        81        56        85
116        113        116        96        57        100
123        118        118        105        70        111
148        139        149        115        115        127
149        145        151        135        151        137
153        148        160        142        163        147
160        161        162        161        164        161

TA的精华主题

TA的得分主题

发表于 2018-12-21 16:38 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
gaoch35 发表于 2018-12-14 16:21
最少只能是9组是吗?有没有更少的组数啊

最少应该是8组。

有很多解:
1        1        1        1        1        1
2        6        13        6        11        11
3        15        19        15        12        12
19        16        25        18        20        19
26        17        28        19        25        26
34        24        29        36        32        31
42        25        30        41        36        41
45        45        41        42        39        44

上面每1列就是一个8组8码解。数字代表10选8的组合序号。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-21 15:43 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-21 14:54 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
香川群子 发表于 2018-12-21 13:25
10选5的万能8码,我也是9组。

香川群子老师帮我改一下代码
下面代码是以5个为一组进行组合的,怎么改成6个啊?改哪些?写出修改后的代码
  1. Sub ZHX()      '可选择是否保留重复组合,方便写入工作表(允许多列)或导出到记事本
  2.     Dim a(), a1(), b1(), c(101 To 9999) As String, c1(), c2(), c3(), c4()
  3.     On Error Resume Next
  4.     Erase c
  5. Application.ScreenUpdating = False
  6. tms = Timer
  7. Set rng = Selection.SpecialCells(xlCellTypeConstants, 3)           '筛选区域内只含数字和文本的单元格
  8.          'xlNumbers 1;xlTextValues 2;xlLogical 4;xlErrors 16
  9.     'Cells(1, "a").Select
  10. If Selection.Count = 1 Then Set rng = Range(Selection.Address)    '当只选一个单元格的时候
  11.     ReDim a(rng.Count)
  12.     For Each cell In rng
  13.         T = Trim(cell.Value)
  14.         If T <> "" Then
  15.             If InStr(T, "  ") > 0 Then        '0值表示没找到双空格
  16.                 Do
  17.                     i = InStr(T, "  ")
  18.                     L = Left(T, i - 1)
  19.                     R = Mid(T, i + 1)
  20.                     T = L & R
  21.                 Loop Until InStr(T, "  ") = 0
  22.             End If
  23.             s = s + 1
  24.             a(s) = T
  25.             n = n + Application.Combin(UBound(Split(a(s), " ")) + 1, 5)
  26.          End If
  27.     Next
  28.     ReDim c3(1 To n)
  29.     For i = 1 To s
  30.         b = Split(a(i), " ")
  31.         n1 = UBound(b) + 1
  32.         ReDim a1(1 To n1), b1(1 To n1)
  33.         For i1 = 1 To n1
  34.             a1(i1) = --b(i1 - 1)
  35.         Next i1
  36.         For i1 = 1 To n1
  37.             b1(i1) = Format(Application.Small(a1, i1), "00")
  38.         Next i1
  39.         For i1 = 1 To n1 - 4
  40.             For i2 = i1 + 1 To n1 - 3
  41.                 For i3 = i2 + 1 To n1 - 2
  42.                     For i4 = i3 + 1 To n1 - 1
  43.                         For i5 = i4 + 1 To n1
  44.            If n <= Rows.Count Then   '若要允许多列就把此行代码改为"If n <= 1 Then"
  45.                    kz = b1(i1) & " " & b1(i2) & " " & b1(i3) & " " & b1(i4) & " " & b1(i5)
  46.                                 j = j + 1
  47.                                 c3(j) = kz
  48.                             Else
  49.                                 k = --(b1(i1) & b1(i2))
  50.                                 kz = b1(i3) & b1(i4) & b1(i5)
  51.                                 If c(k) = "" Then
  52.                                     c(k) = kz
  53.                  Else                                  '若要去除重复组合此行代码改为"ElseIf InStr(c(k), kz) = 0 Then",并改上、下方的代码允许多列
  54.                                     c(k) = c(k) & "," & kz
  55.                                 End If
  56.                             End If
  57.                         Next i5
  58.                     Next i4
  59.                 Next i3
  60.             Next i2
  61.         Next i1
  62.     Next i
  63.     If n <= Rows.Count Then            '若要允许多列就把此行代码改为"If n <= 1 Then"
  64.         With Sheets("Sheet2")
  65.             .Cells.ClearContents
  66.             .Cells(1, 1).Resize(UBound(c3), 1) = Application.Transpose(c3)
  67.             .Columns(1).Sort Key1:=.Range("A1")
  68.             'Call JSB(c3)                  '此代码将组合数据导出到记事本
  69.         End With
  70.     Else
  71.         For i = 101 To 9999
  72.             If c(i) <> "" Then
  73.                 b2 = Split(c(i), ",")
  74.                 n2 = UBound(b2) + 1
  75.                 ReDim c1(1 To n2), c2(1 To n2)
  76.                 For i2 = 1 To n2
  77.                     c1(i2) = --b2(i2 - 1)
  78.                 Next i2
  79.                 For i2 = 1 To n2
  80.                     c2(i2) = Format(Application.Small(c1, i2), "000000")
  81.                     T = Format(i, "0000") & c2(i2)
  82.                     n3 = n3 + 1
  83. c3(n3) = Left(T, 2) & " " & Mid(T, 3, 2) & " " & Mid(T, 5, 2) & " " & Mid(T, 7, 2) & " " & Right(T, 2)
  84.                 Next i2
  85.                 Erase b2
  86.             End If
  87.         Next i
  88.         If n3 <= Rows.Count Then
  89.             Sheets("Sheet2").Cells(1, 1).Resize(n3, 1) = Application.Transpose(c3)
  90.         Else
  91.             ReDim c4(1 To Rows.Count, 1 To n3 \ Rows.Count + 1)
  92.             For i3 = 1 To n3 \ Rows.Count + 1
  93.                 For i4 = 1 To Rows.Count
  94.                     m = m + 1
  95.                     c4(i4, i3) = c3(m)
  96.                     If m = n3 Then Exit For
  97.                 Next i4
  98.             Next i3
  99.             'Sheets("Sheet2").Cells.ClearContents
  100.             Sheets("Sheet2").Cells(1, 1).Resize(UBound(c4, 1), UBound(c4, 2)) = c4
  101.         End If
  102.         Call JSB(c3)                  '此代码将组合数据导出到记事本
  103.     End If
  104.     Application.ScreenUpdating = True
  105.     MsgBox Format(Timer - tms, "0.00s")
  106. End Sub

  107. Sub JSB(d)
  108.     Set fs = CreateObject("scripting.filesystemobject")
  109.     Set f = fs.opentextfile(ActiveWorkbook.Path & "\数据导出.txt", 2, True)
  110.     For i = 1 To UBound(d) + 1
  111.         f.writeline d(i)
  112.     Next i
  113.     f.Close
  114. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 20:09 , Processed in 0.552401 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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