ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[Excel 程序开发] [开_86] 比速度,看谁的程序更快.

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-10-8 13:06 | 显示全部楼层
既然42楼代码有速度优势,那就说还是值得研究。


等我有空,抽时间研究一下代码的思路原理,看看能否debug掉错误。

如果算法有值得借鉴的地方,或许可以让我的递归速度也提高一下。


…………
不过话又说回来,3.48秒的速度,已经不如我的递归3和递归4大约 2.68秒的速度快了。



点评

群子有后发优势,呵呵。我现在同时保留了你和彭希仁的程序。  发表于 2012-10-8 17:10

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-10-8 14:21 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
{:soso_e113:}很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

TA的精华主题

TA的得分主题

发表于 2012-10-8 14:30 | 显示全部楼层
彭希仁 发表于 2012-10-8 14:21
很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

哈哈,那我是大约去年年底开始,看了你的漫谈递归才开始学习递归的。

所以我的递归代码结构,就是完全抄袭您的代码。

只不过在算法上,自己做了些改进。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-10-8 14:32 | 显示全部楼层
本帖最后由 香川群子 于 2012-10-8 14:40 编辑

之前解决问题,都是直接用VBA数组+for……next 或 do……loop循环处理。

现在才发现递归很好玩的。


……
有个hanoi塔的递归,当时看了还是不太能理解。

有空要再捡起来看看哦……


Hanoi.zip (35.03 KB, 下载次数: 90)




TA的精华主题

TA的得分主题

 楼主| 发表于 2012-10-8 15:41 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 彭希仁 于 2012-10-8 16:58 编辑

Dim arr, z As Long, jj As Long, d, j%
Sub peng()
    Set d = CreateObject("Scripting.Dictionary")
    jj = 0
    Open "d:\peng.txt" For Output As #1
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    j = [A65536].End(xlUp).Row
    arr = Range("A1:A" & j)
    z = Cells(1, 2)
    j = j - 1
    aa = Timer
    For i = 1 To UBound(arr)  '定位
        d(arr(i, 1)) = i
    Next i
    Call xi("", 1, 0)
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub
Sub xi(a, X As Long, Y As Long)
    If Y + arr(X, 1) + arr(X + 1, 1) >= z Then    '最后一个数直接定位
        If d.Exists(z - Y) Then
            jj = jj + 1
            'Print #1, z - Y & a
        End If
        If Y + arr(X, 1) + arr(X + 1, 1) = z Then    '这里如果提前算好,会有一点点的提升空间
            jj = jj + 1
            'Print #1, arr(X + 1, 1) & "+" & arr(X, 1) & a
        End If
        Exit Sub
    End If
    If X > j Then Exit Sub    '递归层数
    Call xi("+" & arr(X, 1) & a, X + 1, Y + arr(X, 1))    '
    Call xi(a, X + 1, Y)
End Sub

这样会快很多,不过任何递归都可以转变为非递归,那样速度还有20%的提升空间.

TA的精华主题

TA的得分主题

发表于 2012-10-8 16:58 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 香川群子 于 2012-10-8 17:10 编辑
彭希仁 发表于 2012-10-8 15:41
Public arr, z As Long, jj As Long, d, j%
Sub peng()
    Set d = CreateObject("Scripting.Dictionary ...


我试过了,速度并没有明显提高,
计算1-100求和=100时,比42楼代码略快一些,但不如我的递归代码快。
计算1-20求和=88时耗时0.648秒
计算1-99奇数,求和=150时耗时0.57秒

但是,当计算数据量小的随机整数时,耗时很多要2秒多。
如计算: 2,3,8,11,13,15,21,24,30,31,36,38,47,56,58,65,68,70,71,75 共20个数求和=740(第2个开始所有元素)时,
耗时2.2秒。

而降序递归法只要0秒。

可见,该算法本身还不是很好。

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-10-8 17:13 | 显示全部楼层
未命名.jpg
我电脑上测试,速度是有明显提升的.

TA的精华主题

TA的得分主题

发表于 2012-10-8 17:16 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
彭希仁 发表于 2012-10-8 14:21
很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

呵呵,我是9月28日收到您的站内短信才开始关注这个题目的。

看来提升速度,改变算法才是关键。

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-10-8 17:16 | 显示全部楼层
其这我们可以反其道而行之,对数据真接进行拆分.

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-10-8 17:56 | 显示全部楼层
本帖最后由 彭希仁 于 2012-10-8 17:57 编辑

Dim arr, z As Long, jj As Long, d, j%, xx
Sub peng()
    Set d = CreateObject("Scripting.Dictionary")
    jj = 0
    Open "d:\peng.txt" For Output As #1
    Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    j = [A65536].End(xlUp).Row
    arr = Range("A1:B" & j)
    z = Cells(1, 2)
    For i = 1 To UBound(arr) - 1    '定位
        d(arr(i, 1)) = i
        arr(i, 2) = arr(i, 1) + arr(i + 1, 1)
    Next i
    d(arr(j, 2)) = arr(i, 1)
    d(arr(j, 1)) = i
    j = j - 1
    aa = Timer
    Call xi("", 1, 0)
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
    Close #1
End Sub
Sub xi(a, X As Long, Y As Long)
    If Y + arr(X, 2) >= z Then    '最后一个数直接定位
        If d.Exists(z - Y) Then
            jj = jj + 1
            '     Print #1, z - Y & a
        End If
        If Y + arr(X, 2) = z Then
            jj = jj + 1
            '        Print #1, arr(X + 1, 1) & "+" & arr(X, 1) & a
        End If
        Exit Sub
    End If
    If X > j Then Exit Sub    '递归层数
    Call xi("+" & arr(X, 1) & a, X + 1, Y + arr(X, 1))    '
    Call xi(a, X + 1, Y)
End Sub
再优化了一下,1-100=100   只需1.27秒
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-22 17:14 , Processed in 0.035892 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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