[已解决]VBA做分别减到S列

zss7758258

问题1问题2.zip (159.65 KB, 下载次数: 152)

2014-4-2 10:24 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2014-4-2 11:05

请看附件。

跳转到最佳答案楼层

grf1973

1. 问题一问题二一样的，只要把第一行长度写成5或7.
   
2. Sub tt()
   
3.     xlen = 5
   
4.     With ActiveSheet
   
5.         r = .Cells(.Rows.Count, 4).End(3).Row
   
6.         arr = .Range("d3:s" & r)
   
7.         For i = 1 To UBound(arr)
   
8.             x = CStr(arr(i, 1))
   
9.             y = arr(i, 15) 'R列
   
10.             If Len(x) < xlen Then x = Application.WorksheetFunction.Rept("0", xlen - Len(x)) & x
    
11.             For j = 1 To Len(x)
    
12.                 t = Val(Mid(x, j, 1)) - y
    
13.                 arr(i, 16) = arr(i, 16) & IIf(t > 0, t, t + 10)
    
14.             Next
    
15.         Next
    
16.         .[s3].Resize(UBound(arr), 1) = Application.Index(arr, , 16)
    
17.     End With
    
18. End Sub
    

复制代码

grf1973

代码小改动了一下。

1. Sub 问题一()
   
2.     Call tt(5)
   
3. End Sub
   
4. Sub 问题二()
   
5.     Call tt(7)
   
6. End Sub
   
7. Sub tt(xlen)
   
8.     With ActiveSheet
   
9.         r = .Cells(.Rows.Count, 4).End(3).Row
   
10.         .Range("s3:s" & r).Clear
    
11.         arr = .Range("d3:s" & r)
    
12.         For i = 1 To UBound(arr)
    
13.             x = CStr(arr(i, 1))
    
14.             y = arr(i, 15) 'R列
    
15.             arr(i, 16) = "'"
    
16.             If Len(x) < xlen Then x = Application.WorksheetFunction.Rept("0", xlen - Len(x)) & x
    
17.             For j = 1 To Len(x)
    
18.                 t = Val(Mid(x, j, 1)) - y
    
19.                 arr(i, 16) = arr(i, 16) & IIf(t >= 0, t, t + 10)
    
20.             Next
    
21.         Next
    
22.         .[s3].Resize(UBound(arr), 1) = Application.Index(arr, , 16)
    
23.     End With
    
24. End Sub
    

复制代码

grf1973

请看附件。

爱疯

Function jf(x, y, z%) 'x表示原数,y表示被减数,z表示长度
    Dim i%
    x = Format(x, String(z, "0"))
    For i = 1 To Len(x)
        z = Mid(x, i, 1)
        jf = jf & IIf(z < y, 10 + z - y, z - y)
    Next i
End Function
自定义函数jf.rar (24.89 KB, 下载次数: 2)

2014-4-2 11:30 上传

点击文件名下载附件

zss7758258

1. Sub tt3()
   
2.     xlen = 7  '数字自设
   
3. With ActiveSheet
   
4.         r = .Cells(.Rows.Count, 4).End(3).Row
   
5.         .Range("s3:s" & r).Clear
   
6.         arr = .Range("d3:s" & r)
   
7.         For i = 1 To UBound(arr)
   
8.             x = CStr(arr(i, 1))
   
9.             y = arr(i, 15) 'R列
   
10.             arr(i, 16) = "'"
    
11.             If Len(x) < xlen Then x = Application.WorksheetFunction.Rept("0", xlen - Len(x)) & x
    
12.             For j = 1 To Len(x)
    
13.                 t = Val(Mid(x, j, 1)) - y
    
14.                 arr(i, 16) = arr(i, 16) & IIf(t >= 0, t, t + 10)
    
15.             Next
    
16.         Next
    
17.         .[s3].Resize(UBound(arr), 1) = Application.Index(arr, , 16)
    
18.     End With
    
19. End Sub
    

复制代码