VBA实战(Excel)(5)：介绍一种排列组合算法

已于 2024-06-04 09:59:55 修改
阅读量602 收藏 4
点赞数 8
分类专栏： VBA 文章标签： VBA excel 算法
于 2024-06-03 09:37:22 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/nianfen/article/details/139402521
版权

1. 需求场景

有多个条件，条件个数不定，每个条件有若干种情况，情况个数不定，输出所有条件可能的情况的排列组合。

2.举例

假设第一次有5个情况要填，第一个条件20种情况，第二个5种，第三个40种，第四个10种，第五个4种。那么共要输出条件数=20x5x40x10x4=160000种，第二次可能要输出30万钟，等等......

3.实现程序

Sub getalldata(control As Office.IRibbonControl) '生成
    sht_name = Sheets("参数").Cells(2, 2)
    datamp4 = Sheets(sht_name).Range("A1:Z20000")
    Dim datamp5(50, 2000) As String 'datamp5存储批量条件数据
    Dim datamp6(1000000, 20) As Variant
    Dim ribbon As IRibbonUI
    tn = 0
    For i = 1 To 20000
        If datamp4(i, 1) = "" And datamp4(i, 2) = "" Then
            'Call ProcessBarUpdater(20000, 20000, "正在处理")
            Exit For
        End If
        If datamp4(i, 1) = "" And datamp4(i, 2) <> "" Then
            tn = tn + 1
        End If
    Next
    tnn = 0
    jd = True
    For i = 1 To 20000
        If datamp4(i, 1) = "" And datamp4(i, 2) = "" Then
            Exit For
        End If
        If datamp4(i, 1) = "" And datamp4(i, 2) <> "" Then
            tnn = tnn + 1
            '------处理条件，生成条件二维数组------
            For j = 2 To 25
                If InStr(datamp4(i, j), ";") > 0 Or InStr(datamp4(i, j), "~") > 0 Then
                    If InStr(datamp4(i, j), ";") > 0 Then
                        If InStr(datamp4(i, j), "~") > 0 Then
                            '情况1含波浪号和波浪号
                            n = 0
                            For ni = 0 To UBound(Split(datamp4(i, j), ";"))
                                If InStr(Split(datamp4(i, j), ";")(ni), "~") > 0 Then
                                    For nn = Split(Split(datamp4(i, j), ";")(ni), "~")(0) To Split(Split(Split(datamp4(i, j), ";")(ni), "~")(1), "(")(0) Step Replace(Split(Split(Split(datamp4(i, j), ";")(ni), "~")(1), "(")(1), ")", "")
                                        datamp5(j - 2, n) = nn
                                        n = n + 1
                                    Next
                                    datamp5(j - 2, n) = Split(Split(Split(datamp4(i, j), ";")(ni), "~")(1), "(")(0)
                                    n = n + 1
                                Else
                                    datamp5(j - 2, n) = Split(datamp4(i, j), ";")(ni)
                                    n = n + 1
                                End If
                            Next
                        Else
                            '情况2只含分号
                            For n = 0 To UBound(Split(datamp4(i, j), ";")) '从情况2和情况3理解情况1
                                datamp5(j - 2, n) = Split(datamp4(i, j), ";")(n)
                            Next
                        End If
                    Else
                        '情况3只含波浪号
                        If InStr(datamp4(i, j), "~") > 0 Then
                            n = 0
                            For ni = Split(datamp4(i, j), "~")(0) To Split(Split(datamp4(i, j), "~")(1), "(")(0) Step Replace(Split(Split(datamp4(i, j), "~")(1), "(")(1), ")", "")
                                datamp5(j - 2, n) = ni
                                n = n + 1
                            Next
                            datamp5(j - 2, n) = Split(Split(datamp4(i, j), "~")(1), "(")(0)
                        End If
                    End If
                Else
                    datamp5(j - 2, 0) = datamp4(i, j)
                End If
            Next
            '------处理条件，生成条件二维数组------
            '------计算数据量------
            tn = 1
            For li = 0 To 50 'li为条件个数，lj为每个条件的选项个数
                If datamp5(li, 0) <> "" Then
                    For lj = 0 To 2000
                        If datamp5(li, lj) = "" Then
                            Exit For
                        Else
                            'Debug.Print datamp5(li, lj)
                        End If
                    Next
                    tn = tn * lj
                End If
            Next
            'Debug.Print tn
            '------计算数据量------
            '------二维数组转为一维排列组合------
            For li = 0 To 50 'li为条件个数
                If datamp5(li, 0) <> "" Then
                    For lj = 0 To 2000
                        If datamp5(li, lj) = "" Then
                            Exit For
                        End If
                    Next
                    'Debug.Print lj 'lj为每个条件的选项个数
                    If li = 0 Then
                        For jj = 0 To lj - 1
                            If datamp5(0, jj) <> "" Then
                                datamp6(jj, 0) = datamp5(0, jj) '赋值给数组
                            Else
                                Exit For
                            End If
                        Next
                        'Debug.Print jj’第一个条件的情况数
                    Else
                        'Debug.Print "-----------"
                        If li = 1 Then
                            For ii = 0 To 10000 '每个条件开始前计算已有的情况个数对应的行数
                                If datamp6(ii, 0) = "" Then
                                    Exit For
                                End If
                            Next
                        Else
                            If n = 0 Then
                                For ii = 0 To 10000 '每个条件开始前计算已有的情况个数对应的行数
                                    If datamp6(ii, 0) = "" Then
                                        Exit For
                                    End If
                                Next
                            Else
                                ii = n '
                            End If
                        End If
                        'Debug.Print "ii=" & ii
                        n = 0
                        For mi = 0 To lj - 1 'datamp5第i个条件的选项个数
                            For ni = 0 To ii - 1 'datamp6数组的行数
                                For nj = 0 To li 'datamp6数组的列数
                                    If nj < li Then
                                        '第i之前直接复制
                                        datamp6(n, nj) = datamp6(ni, nj)
        '                                If i < 7 Then
        '                                    Debug.Print n & ";" & ni & ";" & nj
        '                                End If
                                    Else
                                        '第i个取datamp5的值
                                        datamp6(n, nj) = datamp5(li, mi)
        '                                If i < 7 Then
        '                                    Debug.Print n & ";" & i
        '                                End If
                                        'Debug.Print datamp5(i, mi)
                                    End If
                                    If li = 7 Then
                                        'Debug.Print n & "," & nj & "=" & datamp6(n, nj)
                                    End If
                                Next
                                If lj - 1 > 0 Or ii - 1 > 0 Then
                                    n = n + 1
                                End If
                            Next
                        Next
                    End If
                Else
                    Exit For
                End If
                'Debug.Print "n=" & n
            Next
            Application.ScreenUpdating = False
            ni = Sheets("扭矩查询").Range("a" & Rows.Count).End(xlUp).Row + 1
            For li = 0 To 1000000
                If datamp6(li, 0) <> "" Then
                    For j = 0 To 20
                        'Debug.Print i & "," & j & "=" & datamp6(i, j)
                        Sheets("扭矩查询").Cells(ni + li, j + 1) = datamp6(li, j)
                    Next
                Else
                    Exit For
                End If
            Next
            '------二维数组转为一维排列组合------
            Sheets(sht_name).Cells(i, 1) = True
            For t = 1 To 25
                If datamp4(1, t) = "" Then
                    For ti = t + 1 To 26
                        If datamp4(i, ti) = "" Then
                            Sheets(sht_name).Cells(i, ti) = Format(Now(), "YYYY/MM/DD hh:mm")
                            Exit For
                        End If
                    Next
                    Exit For
                End If
            Next
            Erase datamp5
            Erase datamp6
            Application.ScreenUpdating = True
        End If
        If tnn <> 0 And jd = True Then
            'Debug.Print tnn & ";" & tn
            Call ProcessBarUpdater(tnn, tn, "正在处理")
        End If
        If tnn = tn Then
            jd = False
        End If
    Next
    For i = 0 To 50 '打印
        For j = 0 To 500
            If datamp5(i, j) <> "" Then
                'Debug.Print i & ";" & j & "=" & datamp5(i, j)
            Else
                Exit For
            End If
        Next
    Next
    Erase datamp4
End Sub

4. 算法思路讲解

4.1先把条件列转为二维数组，可以得出当前有多少个条件，每个条件多少种情况。

4.2把条件二维数组的第一行（第一种排列组合）赋值给“排列组合”二维数组，此时二维数组只有一行

4.3从“排列组合”一维数组的第一位开始，第一个条件有n种情况，就循环n次赋值，每次只变一位，其他位复制，第二个条件同理，以此类推。

5. 应用实例

此实例涉及商业保密，不便上传文件，想要演示实例，请私信博主。

xwLink1996
关注
  • 8
    点赞
  • 踩
  • 4
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
《平衡掌控者》笔记（结）
packdge_black的博客
07-08 993
总算是完成这本书的阅读了，听说马上水哥要出新书，到时候可以支持一下。 那是否推荐阅读这本书呢？从我的角度来讲，对于一个想了解数值策划的初学者还是可以阅读的。 但是无论书中写的怎样，最终一定要落实到实战上，自己亲手无疑是最有收获的。但是对我来说说，数值的部分可能需要在后期的平衡设置中解决，现阶段还是以做出一个demo为主要目标。 ----------------------------------------------------------------------------------------
VBA实战(Excel)(4)：实用功能整理
nianfen的博客
06-03 780
用于查数据，工作中要打开多个表获取数据再关闭的场景，利用此函数可以将excel表格作为后台数据库查询，快速实现客户要求，缺点是运行效率不够高。此函数能调节插入图片的长宽比，通过等边距裁剪，使图片在Excel中排版统一。避免重复打开客户已经打开的文件，提升体验和效率。针对需要把结果生成一张新表格的客户。针对需要等待的场景，比如等待加载。持续更新中......
Excel 2010实战技巧精粹
weixin_33928467的博客
01-08 1930
《Excel 2010实战技巧精粹》 基本信息 作者： Excel Home 出版社：人民邮电出版社 ISBN：9787115313218 上架时间：2013-3-26 出版日期：2013 年4月 开本：16开 页码：732 版次：1-1 所属分类：计算机 &gt; 办公软件 &gt; OFFICE &gt; Excel 更多关于 》》》《Excel 2010实战技巧精粹...
太强了，用Python+Excel制作天气预报表！
法纳斯特
05-30 708
大家好，我是小F～今天给大家介绍一个Python+Excel的实战项目，非常有趣。主要使用xlwings和requests这两个Python库，以及Office的Excel。xlwings...
excel VBA - 排列组合生成算法 - 可指定和值 - 可输出文本文件.xls
08-29
excel VBA - 排列组合生成算法 - ，可快速生成指定项目的所有排列组合
ExcelVBA:Excel VBA项目
04-06
Excel VBA项目 升序-降序 该宏采用Sheet1中显示的整数，并使用数组以升/降序排列。
ExcelVBA编程实战宝典
07-19
本书在介绍通过VBA操作Excel对象的基础上，使用了大量篇幅介绍使用VBA操作这些新增对象的方法。本书内容全面，讲解由浅入深，每个知识点以实例代码进行介绍，使读者可以快速入门。另外，本书专门提供了大量的配套...
VBA实战：下拉菜单实现快速输入
05-17
VBA实战：下拉菜单实现快速输入
EXCEL_VBA常用代码实战大全.docx
07-31
很喜爱 VBA，喜欢使用她对 Excel 操作实现所需的功能，更喜欢使用 VBA 控制 Excel 以及 实现结果后的那种感觉。 一直都想对 ExcelVBA 进行系统的整理和归纳，但由于对 Excel 及 VBA 了解得不够深入， 总觉得无从下手...
system与excel族函数区别
qq_62821433的博客
06-16 470
comand是命令的路径，一般我们用绝对路径system函数会创建新的进程，新的进程执行完返回原来的进程，原来的进程则继续执行后面的代码段。如我们创建一个sys.cpp文件，在其中去执行另一个sys1可执行文件同目录下创建一个sys1.cpp文件，然后将其编译链接为可执行文件可以看出先执行完sys1后又返回原来的进程执行了。
python写excel
sinat_35773915的博客
06-17 447
你可以根据需要选择适合你的条件类型，并结合格式化选项来实现所需的效果。如果你需要更多详细信息，可以参考 XlsxWriter 官方文档。通过这样设置，Excel 文件中大于5的单元格将显示为浅红色背景和深红色字体，以便突出显示这些符合条件的单元格。每种条件类型还可以有更加具体的配置选项。
《梦醒蝶飞：释放Excel函数与公式的力量》1.1.9 Excel智能查找功能
wfbl123456的博客
06-14 414
中的智能查找功能是Office 365和Microsoft 365订阅服务的一部分，它提供了一种增强的搜索体验，允许用户快速查找和获取有关选定内容的信息。智能查找功能是Excel中一个强大的工具，尤其适合需要快速获取大量信息的场景。如果智能查找没有自动显示您需要的信息，您可以在搜索框中输入关键词，以获取更具体的搜索结果。智能查找集成在Excel的功能区中，提供了一个搜索框，允许用户输入查询。智能查找提供的信息是实时的，确保用户获得最新的数据和信息。智能查找会根据选定的单元格内容提供相关的搜索结果和信息。
mac 常用工具命令集合
最新发布
hcgeng的专栏
06-21 987
%s/old/new/gc 搜索整个文件，将所有的old替换为new，每次都要你确认是否替换。选中多行后按command + ]可以增加缩进，按command + [可以减少缩进。6、快速复制一行：Command+shift+D(将光标定位到要复制文字的后面)15、光标定位行，快速整体移动一行：Command+shift+上箭头/下箭头。16、布局：Command+Alt+2/3/4/5、Command+Alt。搜索则是向上的下一个)注：command + f 只能打开一个空空的搜索框，
Arcgis导入excel出现的问题
Darkangel666999的博客
06-18 187
指定的表没有object-id字段
easyexcel和poi版本冲突报错深入解析v2
张丁花的博客
06-18 1367
那么我们就可以大胆的猜测了（为什么时猜测，我也不知道对不对，欢迎大家讨论）编译阶段，仅仅对直接引入的库中的方法进行检测是否存在，例如这里只判断easye库的MyGet.testGet，而easye库如果引用了其他库的方法，例如poi中的方法，由于已经编译成了MyGet.class，不再进行MyGet.class重新编译，所以深层的方法不在编译器发现（因为编译MyTest.class，只需要知道MyGet.testGet即可）。JVM运行时，会根据方法的签名进行调用，如果方法的签名不在，报错。
掌握Linux Vim：从基础到高级的全面指南
06-18 692
Vim是一款在Linux世界中备受推崇的文本编辑器，它以其强大的功能和高效的操作模式闻名于世。尽管Vim的学习曲线较陡，但一旦掌握，你将发现它在代码编辑和文本处理方面的无与伦比的优势。本文将从Vim的基础知识开始，逐步深入到高级用法和技巧，帮助你全面掌握这款强大的编辑器。
Excel 常用技巧（五）
好好学习 天天向上
06-17 540
Microsoft Excel 是微软为 Windows、macOS、Android 和 iOS 开发的电子表格软件，可以用来制作电子表格、完成许多复杂的数据运算，进行数据的分析和预测，并且具有强大的制作图表的功能。由于 Excel 具有十分友好的人机界面和强大的计算功能，它已成为国内外广大用户管理公司和个人财务、统计数据、绘制各种专业化表格的得力助手。
Excel VLOOKUP 使用记录
weixin_44326073的博客
06-17 417
Excel VLOOKUP 使用记录
VBA 怎么将Excel A1:B60 放置在数组内
04-27
可以使用 VBA 中的数组和循环来将 Excel A1:B60 放置在数组内，具体实现步骤如下： 1. 定义一个二维数组，用于存储 Excel A1:B60 中的数据。 2. 使用循环将 Excel A1:B60 中的数据逐个读取出来，并存储到数组中。 3. 最后可以通过遍历数组的方式来使用数组中的数据。 下面是示例代码： ```VBA Sub LoadDataToArray() Dim data() As Variant Dim i As Integer, j As Integer '将 Excel A1:B60 范围的数据存储到数组中 ReDim data(1 To 60, 1 To 2) For i = 1 To 60 For j = 1 To 2 data(i, j) = Range("A" & i + 1 + j).Value Next j Next i '遍历数组中的数据 For i = 1 To 60 For j = 1 To 2 Debug.Print data(i, j) Next j Next i End Sub ``` 其中，`ReDim` 语句用于定义数组的维度，`Range` 函数用于获取 Excel 中的数据，`Debug.Print` 语句用于输出数组中的数据。

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值