ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 2767|回复: 17

[讨论] 汉诺塔动画(修复了了两个问题),很少发主题帖, 大家提提意见吧

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-11-4 16:41 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:递归
本帖最后由 liulang0808 于 2014-11-12 09:49 编辑

极少发主题帖,今天抽空临时做了个汉诺塔动画,靠循环次数控制画面移动的。

由于时间不够了,做了半成品
存在问题:
1、相邻两个盘子移动一个,另一个边线受影响
2、盘子挪动后,需要落到柱子的最下面盘子上面,现在有悬空的,需要调整

其他可能还存在问题,请大家完善吧

hn.zip

17.15 KB, 下载次数: 59

hn(ok).zip

17.16 KB, 下载次数: 60

修复不足

评分

参与人数 3鲜花 +6 收起 理由
aoe1981 + 2 优秀作品
bagu + 2 值得肯定
lm1221 + 2 支持下

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-4 19:56 | 显示全部楼层
修复了以上的两个问题。。。。

hn.zip

18.06 KB, 下载次数: 103

点评

烦请关注下帖:http://club.excelhome.net/thread-1169124-1-1.html  发表于 2014-11-29 01:22

TA的精华主题

TA的得分主题

发表于 2014-11-4 20:03 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-11-4 20:28 | 显示全部楼层
liulang0808 发表于 2014-11-4 19:56
修复了以上的两个问题。。。。

速度也快了 很好

点评

谢谢,spd那个过程,可以修改q,来调整速度  发表于 2014-11-4 20:40

TA的精华主题

TA的得分主题

发表于 2014-11-5 10:06 | 显示全部楼层
呵呵,是否可以做成平面的圆形重叠,通过颜色底色的显示、不显示就可以了。不需要移动圆片的位置的。

…………
有空我来写一个。

点评

唉,当时没有细读帖,原来这儿已经有思路介绍了……惭愧!  发表于 2014-11-30 10:04

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-5 10:11 | 显示全部楼层
香川群子 发表于 2014-11-5 10:06
呵呵,是否可以做成平面的圆形重叠,通过颜色底色的显示、不显示就可以了。不需要移动圆片的位置的。

… ...

谢谢群子老师的建议。当时只是感觉有现成的表格边框可以利用,就直接使用了

TA的精华主题

TA的得分主题

发表于 2014-11-5 10:32 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-11-5 11:50 | 显示全部楼层
liulang0808 发表于 2014-11-4 19:56
修复了以上的两个问题。。。。

高手就是不一样。谢谢分享

TA的精华主题

TA的得分主题

发表于 2014-11-5 11:51 | 显示全部楼层
本帖最后由 香川群子 于 2014-11-5 12:19 编辑

呵呵,我的代码很简单。

下面是图例。
hanoi move_Pic_2.jpg
hanoi move_Pic_1.jpg

hanoi move.zip

20.93 KB, 下载次数: 37

评分

参与人数 2鲜花 +4 收起 理由
lm1221 + 2 优秀作品
aoe1981 + 2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-11-5 12:18 | 显示全部楼层
相关代码:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Target.Address = "$E$1" Then Call Hanoi(Target.Value) '改变E1中数值时自动开始
  3. End Sub

  4. Sub Hanoi(n) '初始化
  5.     For i = 0 To 26
  6.         t = Chr(i \ 9 + 65) & "_" & (i Mod 9 + 1)
  7.         ActiveSheet.Shapes(t).Visible = IIf(i < n, True, False) '显示或不显示
  8.     Next
  9.     Call dg_Hanoi(n, "A", "C", "B") '调用递归
  10. End Sub

  11. Sub dg_Hanoi(n, a, c, b) '递归过程
  12.     If n = 1 Then
  13.         Range("K65536").End(xlUp).Offset(1) = "Move " & n & ": " & a & "->" & c '在K列记录过程
  14.         Range("G18") = "Move " & n & ": " & a & "->" & c  '在G18显示当前步骤        
  15.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
  16.         ActiveSheet.Shapes(a & "_" & n).Visible = False '移走不显示
  17.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
  18.         ActiveSheet.Shapes(c & "_" & n).Visible = True '移到后显示
  19.         Application.Wait Now + TimeValue("00:00:01") '延时1秒

  20.     Else
  21.         Call dg_Hanoi(n - 1, a, b, c)

  22.         Range("K65536").End(xlUp).Offset(1) = "Move " & n & ": " & a & "->" & c '在K列记录过程
  23.         Range("G18") = "Move " & n & ": " & a & "->" & c  '在G18显示当前步骤        
  24.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
  25.         ActiveSheet.Shapes(a & "_" & n).Visible = False '移走不显示
  26.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
  27.         ActiveSheet.Shapes(c & "_" & n).Visible = True '移到后显示
  28.         Application.Wait Now + TimeValue("00:00:01") '延时1秒

  29.         Call dg_Hanoi(n - 1, b, c, a)
  30.     End If
  31. End Sub
复制代码

点评

这个创意很好的  发表于 2014-11-5 13:35
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2019-10-22 04:45 , Processed in 0.089900 second(s), 26 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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