汉诺塔演示程序

jaxxcyh

用递归编了一个汉诺塔演示程序，程序写的比较简单，欢迎讨论。

1. Public m&, a(), b(), c()      'm金片数,及a,b,c金片数组
   
2. '主程序 （By 风中浮云)
   
3. Sub MainPrg()
   
4.     n = [f1].Value       '修改金片数(10以内)
   
5.     m = n
   
6.    
   
7.     ReDim a(1 To n)
   
8.     ReDim b(1 To n)
   
9.     ReDim c(1 To n)
   
10.    
    
11.     For i = n To 1 Step -1
    
12.         a(n + 1 - i) = i
    
13.     Next
    
14.     Range("a1:c10").ClearContents
    
15.    
    
16.     Call dispArr
    
17.     Call hannuo(n, "A", "B", "C")
    
18.    
    
19.     MsgBox "OK"
    
20. End Sub
    
21. 
    
22. 
    
23. '汉诺塔算法基本框架
    
24. Sub hannuo(n, p1, p2, p3)
    
25.     If n = 1 Then
    
26.         Call MoveIt(p1, p3)            '只有1块金片时直接从p1移到p3
    
27.         Exit Sub
    
28.     Else
    
29.         Call hannuo(n - 1, p1, p3, p2) '将n-1个金片从p1移到p2
    
30.         Call MoveIt(p1, p3)            '将n号金片从p1移到p3
    
31.         Call hannuo(n - 1, p2, p1, p3) '将n-1个金片从p2移到p3
    
32.     End If
    
33. 
    
34. End Sub
    
35. 
    
36. '移动两块金片x,y
    
37. Sub MoveIt(x, y)
    
38.     Debug.Print x & "--->" & y
    
39.    
    
40.     '根据移动对象修改对应数组，分6种情况处理
    
41.     j = 0: k = 0
    
42.     If x = "A" And y = "B" Then     '如果移动A柱金片到B柱
    
43.         For i = 1 To m              '扫描a,b数组最后一块金片的位置
    
44.             If a(i) > 0 Then j = j + 1
    
45.             If b(i) > 0 Then k = k + 1
    
46.         Next
    
47.         tmp = a(j)
    
48.         a(j) = Null          'a数组拿掉最后一块金片
    
49.         b(k + 1) = tmp       'b数组增加一块金片
    
50.     End If
    
51.    
    
52.     If x = "A" And y = "C" Then
    
53.         For i = 1 To m
    
54.             If a(i) > 0 Then j = j + 1
    
55.             If c(i) > 0 Then k = k + 1
    
56.         Next
    
57.         tmp = a(j)
    
58.         a(j) = Null
    
59.         c(k + 1) = tmp
    
60.     End If
    
61.    
    
62.     If x = "B" And y = "C" Then
    
63.         For i = 1 To m
    
64.             If b(i) > 0 Then j = j + 1
    
65.             If c(i) > 0 Then k = k + 1
    
66.         Next
    
67.         tmp = b(j)
    
68.         b(j) = Null
    
69.         c(k + 1) = tmp
    
70.     End If
    
71. 
    
72.     If x = "B" And y = "A" Then
    
73.         For i = 1 To m
    
74.             If b(i) > 0 Then j = j + 1
    
75.             If a(i) > 0 Then k = k + 1
    
76.         Next
    
77.         tmp = b(j)
    
78.         b(j) = Null
    
79.         a(k + 1) = tmp
    
80.     End If
    
81. 
    
82.     If x = "C" And y = "A" Then
    
83.         For i = 1 To m
    
84.             If c(i) > 0 Then j = j + 1
    
85.             If a(i) > 0 Then k = k + 1
    
86.         Next
    
87.         tmp = c(j)
    
88.         c(j) = Null
    
89.         a(k + 1) = tmp
    
90.     End If
    
91.         
    
92.     If x = "C" And y = "B" Then
    
93.         For i = 1 To m
    
94.             If c(i) > 0 Then j = j + 1
    
95.             If b(i) > 0 Then k = k + 1
    
96.         Next
    
97.         tmp = c(j)
    
98.         c(j) = Null
    
99.         b(k + 1) = tmp
    
100.     End If
     
101.    
     
102.     Call dispArr  '移动完毕显示当前状态
     
103. End Sub
     
104. 
     
105. '显示当前状态
     
106. Sub dispArr()
     
107.     For i = 1 To 3
     
108.         For j = 1 To m
     
109.             Cells(11 - j, 1).Value = a(j)
     
110.             Cells(11 - j, 2).Value = b(j)
     
111.             Cells(11 - j, 3).Value = c(j)
     
112.         Next
     
113.     Next
     
114. End Sub
     

复制代码

micch

找了个以前的视频截一个GIF图

likaiyihou

之前学习递归的时候自己也写了一个汉诺塔

jaxxcyh

micch 发表于 2024-10-19 13:50
找了个以前的视频截一个GIF图

有源代码吗，发一个学习一下

jaxxcyh

likaiyihou 发表于 2024-10-19 15:07
之前学习递归的时候自己也写了一个汉诺塔

学习了，你是把所有步骤全列举出来，再根据每个步骤来移动单元格里的数字。

micch

jaxxcyh 发表于 2024-10-19 16:07
有源代码吗，发一个学习一下

几年前的东西了，刚学代码的时候论坛抄代码学习，应该是抄了香川老师的代码，自己加两个图表结合演示。文件早没了电脑都换过两次了，视频还是在云端找到的

micch