ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[讨论]排列组合之最优算法

[复制链接]

TA的精华主题

TA的得分主题

发表于 2007-11-12 09:38 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖已被收录到知识树中,索引项:其他结构和算法

任意M个数字,对它们进行N个数的排列组合,并全部显示出来.COMBIN(M,N)

星期天白天睡多了,搞得我晚上失眠,无聊之中冒出以下排列组合的算法.

一般算法

Sub pengxi()
    aa = Timer
    Dim x%
    Dim i%
    Dim j%
    Dim jj As Long
    a = [A65536].End(xlUp).Row + 1
    arr = Range("A1:A" & a)
    z = Cells(1, 2)
    ReDim arr1(1 To z + 1) As Long   '存地址
    ReDim arr2(1 To z + 1)   '存组合
   
    Open "d:\peng.txt" For Output As #1
    For i = z To 1 Step -1    '初始化
        arr1(i) = i
        arr2(i) = arr2(i + 1) & " " & arr(i, 1)
    Next i
    arr1(z + 1) = 1000
    Do
        jj = jj + 1                   '输出结果
     Print #1, arr2(1)

        For i = 1 To z
            If arr1(i + 1) - arr1(i) > 1 Then Exit For
        Next i

        arr1(i) = arr1(i) + 1
        arr2(i) = arr2(i + 1) & " " & arr(arr1(i), 1)

        For j = i - 1 To 1 Step -1
            arr1(j) = j
            arr2(j) = arr2(j + 1) & " " & arr(j, 1)
        Next j
    Loop While arr1(z) < a
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub
递归算法

Sub peng()
    aa = Timer
    Dim jj As Long, cc As Long
    Open "d:\peng.txt" For Output As #1
    arr = Range("A1:A" & [A65536].End(xlUp).Row)
    Call xi("", arr, 1, 0, Cells(1, 2), jj)
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub

Sub xi(a, arr, x As Long, y As Long, z As Long, jj As Long)
    If y = z Then
        jj = jj + 1
        Print #1, a
        Exit Sub
    End If
    If x = UBound(arr) + 1 Then Exit Sub
    If y + UBound(arr) - x + 1 < z Then Exit Sub
    Call xi(a & " " & arr(x, 1), arr, x + 1, y + 1, z, jj)  '字附串和数字的处理速度是相差很大的
    Call xi(a, arr, x + 1, y, z, jj)
End Sub

LrTBjr9k.rar (10.65 KB, 下载次数: 2169)
[此贴子已经被作者于2007-11-12 16:39:48编辑过]

OykgaCRR.rar

8.31 KB, 下载次数: 1622

[讨论]排列组合之最优算法

UZ3S3GNl.rar

10.76 KB, 下载次数: 1500

[讨论]排列组合之最优算法

TA的精华主题

TA的得分主题

发表于 2007-11-12 09:46 | 显示全部楼层

厉害厉害,彭希仁又出新作品了!

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-11-12 11:44 | 显示全部楼层

以上解法,递归算法比一般算法要慢20%左右,是递归本身的先天不足所引起的(程序在调用下一个过程的时候程序会把当然所有的变量先存起来,会占用时间).可通过披上羊皮来弥补不足.

当然以上两种算法实现的原理是不一样的

递归用的是二进制\剪枝原理.

而一般算法用的原理我也说不上来是什么.有点象搬箱子吧

TA的精华主题

TA的得分主题

发表于 2007-11-12 12:27 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
递归算法还没学过呢!

TA的精华主题

TA的得分主题

发表于 2007-11-12 17:41 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2007-11-12 20:23 | 显示全部楼层
俺也收下学习!
连狼版都要向你学习,可见有多高了!



不过有一点你要向我学习的是怎么打MM的望^_^,我看你好像也是发现了点什么........

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-11-12 20:31 | 显示全部楼层
QUOTE:
以下是引用TGB在2007-11-12 20:23:12的发言:
俺也收下学习!
连狼版都要向你学习,可见有多高了!



不过有一点你要向我学习的是怎么打MM的望^_^,我看你好像也是发现了点什么........

呵呵,这MM是我女儿.很可爱吧.

TA的精华主题

TA的得分主题

发表于 2007-11-12 20:41 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

谢了,楼主。

TA的精华主题

TA的得分主题

发表于 2007-11-12 20:46 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
原来是彭兄的女儿(我还以为是男孩),真的好可爱!

这么看来,我比你虚长了,我女儿读初二了。

看来我们都只有当外公的命了——当不成爷爷了,哈哈哈哈

TA的精华主题

TA的得分主题

发表于 2007-11-12 20:58 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

TGB,厉害.我认为彭老师,小时候的照片.

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

本版积分规则

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

GMT+8, 2024-12-5 10:30 , Processed in 0.062805 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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