ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

数据分组、搭配问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-12-25 23:11 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 jyin218 于 2023-12-26 00:23 编辑

1.从1.2.3.4.5.6.7.8.9.10.11.12
中选3个,进行组合。
2.将这些组合4个为一组进行搭配。
3.搭配后每组都包含1.2.3.4.5.6.7.8.9.10.11.12。
求实现excelVBA代码。

Sub Combination()
    Dim i As Long, j As Long, k As Long
    Dim arr() As Variant
    Dim count As Long
    Dim tempArr() As Variant
    Dim output() As Variant
    Dim allNums As Variant

    ' 初始化数字数组
    allNums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)

    ' 生成所有可能的3数字组合
    ReDim arr(1 To 12, 1 To 20000)
    count = 0
    For i = 1 To 12
        For j = i + 1 To 12
         For k = j + 1 To 12
            count = count + 1
            arr(count, 1) = allNums(i)
            arr(count, 2) = allNums(j)
            arr(count, 3) = allNums(k)
         Next k
      Next j
    Next i

    ' 对每4个组合进行搭配,确保每组包含所有数字
    Do While UBound(arr, 1) > 0
        tempArr = RemoveDuplicates(arr)
        If UBound(tempArr, 1) >= 4 Then
            output = output & "(" & Join(tempArr, ",") & ")" & ","
        End If
        arr = tempArr: ReDim arr(1 To UBound(arr, 1))
    Loop
    output = Left(output, Len(output) - 1) ' 去掉最后一个多余的逗号
    MsgBox "可能的组合为:" & output
End Sub
Function RemoveDuplicates(arr() As Variant) As Variant()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, output() As Variant
    ReDim output(1 To UBound(arr, 1))
    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        If Not dict.Exists(arr(i, 1)) Then
            dict.Add Key:=arr(i, 1), Item:=True ' 只检查第一列,因为每一行都不同
            output(dict.Count) = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i+1, 1) & "," & arr(i+2, 2) & "," & arr(i+3, 3)
        End If
    Next i
    RemoveDuplicates = output
End Function

以上代码实现不了,请求检查指导,谢谢。

TA的精华主题

TA的得分主题

发表于 2023-12-26 18:14 | 显示全部楼层
理解有误。
220组,每组只能使用一次。
试了一下,没成功组合到55组。

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-12-26 22:37 | 显示全部楼层

谢谢大神!可能我表述得不够清楚。具体是这样的:
1.从1.2.3.4.5.6.7.8.9.10.11.12
中选3个数,进行组合,共220个组合。
2.将这220个组合以4个为一组进行搭配,每个组合只能搭配一次,共55组。
3.搭配后每组都包含1.2.3.4.5.6.7.8.9.10.11.12。

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-12-27 12:07 | 显示全部楼层
山菊花 发表于 2023-12-26 18:14
理解有误。
220组,每组只能使用一次。
试了一下,没成功组合到55组。

总之,谢谢你。

TA的精华主题

TA的得分主题

发表于 2024-1-10 13:07 | 显示全部楼层
jyin218 发表于 2023-12-26 22:37
谢谢大神!可能我表述得不够清楚。具体是这样的:
1.从1.2.3.4.5.6.7.8.9.10.11.12
中选3个数,进行组 ...

12个元素分成4组,每组3个元素:C(12,3)*C(9,3)*C(6,3)*C(3,3)/4!=15400
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-23 19:31 , Processed in 0.040164 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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