[已解决]求公式改vba

oplkj

123.rar (33.56 KB, 下载次数: 15)

2014-1-20 15:39 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2014-1-20 17:04

说实话，公式真不懂，但你的意思懂了，附件请测试。

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

复制代码

跳转到最佳答案楼层

QLZ0602

好复杂

CheryBTL

这个题怎么感觉前几天做过？ 简单调整下代码即可了呀。

大灰狼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

复制代码

hannanrenjie

是用VBA计算？