agstick版主的捡金币问题

lxdexcel

1. Option Explicit
   
2. 
   
3. Dim map() As Long
   
4. Dim path() As Variant
   
5. 
   
6. 
   
7. Private Sub cmdCount_Click()
   
8. Dim n&, x&, y&, x1&, y1&, k&, p&
   
9. 
   
10.    n = Range("m2")
    
11.   
    
12.   Range("p4") = count(n, map, path)
    
13.   
    
14.    Cells(n, n).Interior.Color = RGB(225, 0, 0) Xor RGB(0, 155, 21)
    
15.    x = n - 1
    
16.    x1 = n - 1
    
17.   For k = 2 * n - 2 To 1 Step -1
    
18.      p = path(k)(x)(x1)
    
19.      
    
20.      If (p = 2) Or (p = 3) Then x = x - 1
    
21.      y = k - 1 - x
    
22.      Cells(y + 1, x + 1).Interior.Color = RGB(225, 0, 0)
    
23.      If (p = 1) Or (p = 3) Then x1 = x1 - 1
    
24.      y1 = k - 1 - x1
    
25.       Cells(y1 + 1, x1 + 1).Interior.Color = RGB(0, 155, 21) Xor Cells(y1 + 1, x1 + 1).Interior.Color
    
26.   Next
    
27. End Sub
    
28. 
    
29. Private Sub cmdStat_Click()
    
30. 
    
31. Dim n&, num&, max&, i&, j&
    
32. 
    
33. Range("a1:j10").ClearContents
    
34. Range("a1:j10").Interior.Pattern = xlPatternNone
    
35. 
    
36. n = Range("m2")
    
37. num = Range("n2")
    
38. max = Range("o2")
    
39. If n < 1 Or n > 15 Then MsgBox "格子个数超出范围": Exit Sub
    
40. If num > n * n Then MsgBox "个数超出范围": Exit Sub
    
41. createMap n, num, max, map
    
42. For i = 0 To n - 1
    
43. For j = 0 To n - 1
    
44.     If map(i, j) > 0 Then Cells(j + 1, i + 1) = map(i, j)
    
45. Next
    
46. Next
    
47. End Sub
    
48. Sub createMap(n As Long, num As Long, max As Long, map() As Long)
    
49. 
    
50. Dim temp&(), i&, r&, s&, last&, m&
    
51. 
    
52. last = n * n - 1
    
53. ReDim temp(0 To last)
    
54. ReDim map(0 To n, 0 To n)
    
55. 
    
56. For i = 0 To last
    
57.     temp(i) = i
    
58. Next
    
59. 
    
60. VBA.Randomize
    
61. For i = 0 To num - 1
    
62.     s = Int(max * Rnd + 1)
    
63.     r = Int(Rnd * (last - i))
    
64.     m = temp(r)
    
65.     map(m Mod n, m \ n) = s
    
66.     temp(r) = temp(last - i)
    
67. Next
    
68. 
    
69. End Sub
    
70. 
    
71. Function count(n As Long, map() As Long, path() As Variant) As Long
    
72.    
    
73.    Dim k&, x&, y&, x1&, y1&, xs&, xe&, last&, cur&, before&
    
74.    Dim p() As Variant
    
75.    Dim p1() As Byte
    
76.    Dim state() As Long
    
77.    
    
78.    last = n * 2 - 2
    
79.    ReDim path(0 To last)
    
80.    ReDim state(1, n - 1, n - 1)
    
81.    state(0, 0, 0) = map(0, 0)
    
82.    before = 0
    
83.    
    
84.    For k = 1 To last
    
85.      If k < n Then
    
86.         xs = 0
    
87.         xe = k
    
88.      Else
    
89.         xs = k - (n - 1)
    
90.         xe = n - 1
    
91.      End If
    
92.      ReDim p(xs To xe)
    
93.      
    
94.      Dim s1&, s&, s0&, sMax&
    
95.      
    
96.      cur = before Xor 1
    
97.      
    
98.      For x = xs To xe
    
99.         ReDim p1(x To xe)
    
100.         y = k - x
     
101.         s = map(x, y)
     
102.         
     
103.         For x1 = x To xe
     
104.               
     
105.         sMax = 0
     
106.         y1 = k - x1
     
107.         s1 = map(x1, y1)
     
108.         If y > 0 Then
     
109.             If x1 > 0 And x <> x1 Then
     
110.                 s0 = state(before, x, x1 - 1) + s + s1
     
111.                 If s0 >= sMax Then
     
112.                      sMax = s0
     
113.                      p1(x1) = 1
     
114.                 End If
     
115.             End If
     
116.             If y1 > 0 Then
     
117.                 s0 = state(before, x, x1) + s
     
118.                 If x <> x1 Then s0 = s0 + s1
     
119.                 If s0 >= sMax Then
     
120.                    sMax = s0
     
121.                     p1(x1) = 0
     
122.                 End If
     
123.             End If
     
124.         End If
     
125.         If x > 0 Then
     
126.             If x1 > 0 Then
     
127.                 s0 = state(before, x - 1, x1 - 1) + s
     
128.                 If x <> x1 Then s0 = s0 + s1
     
129.                 If s0 >= sMax Then
     
130.                    sMax = s0
     
131.                     p1(x1) = 3
     
132.                 End If
     
133.             End If
     
134.             If y1 > 0 Then
     
135.                 s0 = state(before, x - 1, x1) + s
     
136.                 If x <> x1 Then s0 = s0 + s1
     
137.                 If s0 >= sMax Then
     
138.                    sMax = s0
     
139.                    p1(x1) = 2
     
140.                 End If
     
141.             End If
     
142.          End If
     
143.          state(cur, x, x1) = sMax
     
144.         
     
145.      Next
     
146.      p(x) = p1
     
147.     Next
     
148.    
     
149.     path(k) = p
     
150.     before = cur
     
151.   Next
     
152.   
     
153.   count = state(before, x - 1, x1 - 1)
     
154.   
     
155. End Function
     
156. 
     
157. 
     
158. 
     
159. 
     

复制代码