[已解决]代码能不能再优化下

oplkj

book1.rar (36.2 KB, 下载次数: 11)

2014-1-20 23:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2014-1-21 09:33

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, k&, n&, s$, l&, x&, y&
   
3. arr = [d1].CurrentRegion
   
4. n = 1
   
5. For y = 16 To 34 Step 17
   
6.   For x = 1 To 2
   
7.     For j = 1 To UBound(arr, 2) - 1
   
8.       For k = 1 To 3
   
9.         l = 10: l1 = 10
   
10.         For i = y + x - 16 To y + x - 1
    
11.           If y = 16 Then If i = y + x - 15 Or i = y + x - 3 Then n = -1
    
12.           If y = 33 Then If i = y + x - 15 Or i = y + x - 12 Or i = y + x - 3 Then n = -1
    
13.           l = l + n * Val(Mid(arr(i, j), k, 1))
    
14.           n = 1
    
15.         Next i
    
16.         s = s & l Mod 10
    
17.       Next k
    
18.       arr(y + x - 1, j + 1) = s: s = ""
    
19.     Next j
    
20.   Next x
    
21. Next y
    
22. [d1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
23. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

刚才给过你的,应该还有更简便的方法吧

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, k&, n&, s$, s1$, l&, l1&, x&, y&
   
3. arr = [d1].CurrentRegion
   
4. n = 1
   
5. For x = 16 To 17
   
6.   For j = 1 To UBound(arr, 2) - 1
   
7.     For k = 1 To 3
   
8.       l = 10: l1 = 10
   
9.       For i = x - 15 To x
   
10.         If i = x - 14 Or i = x - 2 Then n = -1
    
11.         l = l + n * Val(Mid(arr(i, j), k, 1))
    
12.         n = 1
    
13.       Next i
    
14.       For i = x + 2 To x + 17
    
15.         If i = x + 3 Or i = x + 6 Or i = x + 15 Then n = -1
    
16.         l1 = l1 + n * Val(Mid(arr(i, j), k, 1))
    
17.         n = 1
    
18.       Next i
    
19.       s = s & l Mod 10: s1 = s1 & l1 Mod 10
    
20.     Next k
    
21.     arr(x, j + 1) = s: s = ""
    
22.     arr(x + 17, j + 1) = s1: s1 = ""
    
23.   Next j
    
24. Next x
    
25. [d1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
26. End Sub

复制代码

大灰狼1976

又加了一层循环,简化了代码,如果需要扩展区域,只要简单作相应修改就行了.

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, k&, n&, s$, s1$, l&, l1&, x&, y&
   
3. arr = [d1].CurrentRegion
   
4. n = 1
   
5. For y = 16 To 34 Step 17
   
6.   For x = 1 To 2
   
7.     For j = 1 To UBound(arr, 2) - 1
   
8.       For k = 1 To 3
   
9.         l = 10: l1 = 10
   
10.         For i = y + x - 16 To y + x - 1
    
11.           If y = 16 Then If i = y + x - 15 Or i = y + x - 3 Then n = -1
    
12.           If y = 33 Then If i = y + x - 15 Or i = y + x - 12 Or i = y + x - 3 Then n = -1
    
13.           l = l + n * Val(Mid(arr(i, j), k, 1))
    
14.           n = 1
    
15.         Next i
    
16.         s = s & l Mod 10: s1 = s1 & l1 Mod 10
    
17.       Next k
    
18.       arr(x, j + 1) = s: s = ""
    
19.       arr(x + 17, j + 1) = s1: s1 = ""
    
20.     Next j
    
21.   Next x
    
22. Next y
    
23. [d70].Resize(UBound(arr), UBound(arr, 2)) = arr
    
24. End Sub

复制代码

oplkj

大灰狼1976 发表于 2014-1-20 23:50
又加了一层循环,简化了代码,如果需要扩展区域,只要简单作相应修改就行了.

没有结果呀

大灰狼1976

忘记把最后一行改回来了：
[d1].Resize(UBound(arr), UBound(arr, 2)) = arr
还是不行，不好意思，我再看看，今天比较忙，可能要晚一点

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, k&, n&, s$, l&, x&, y&
   
3. arr = [d1].CurrentRegion
   
4. n = 1
   
5. For y = 16 To 34 Step 17
   
6.   For x = 1 To 2
   
7.     For j = 1 To UBound(arr, 2) - 1
   
8.       For k = 1 To 3
   
9.         l = 10: l1 = 10
   
10.         For i = y + x - 16 To y + x - 1
    
11.           If y = 16 Then If i = y + x - 15 Or i = y + x - 3 Then n = -1
    
12.           If y = 33 Then If i = y + x - 15 Or i = y + x - 12 Or i = y + x - 3 Then n = -1
    
13.           l = l + n * Val(Mid(arr(i, j), k, 1))
    
14.           n = 1
    
15.         Next i
    
16.         s = s & l Mod 10
    
17.       Next k
    
18.       arr(y + x - 1, j + 1) = s: s = ""
    
19.     Next j
    
20.   Next x
    
21. Next y
    
22. [d1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
23. End Sub

复制代码