[已解决]按要求标数值的问题

李全有

附件 按要求标数值附件.zip (214.26 KB, 下载次数: 7)

2015-3-17 16:36 上传

点击文件名下载附件
谢谢老师！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-17 17:00

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, p$
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 1)
   
5. For i = 1 To UBound(arr)
   
6.     p = ""
   
7.     For j = 1 To UBound(arr, 2)
   
8.         x = (Abs(arr(i, j)) - 1) \ 12 + 1
   
9.         p = p & "=" & x
   
10.     Next
    
11.     brr(i, 1) = Mid(p, 2)
    
12. Next
    
13. Range("e1").Resize(UBound(brr)) = brr
    
14. End Sub

复制代码

跳转到最佳答案楼层

26759761@qq.com

你没说最小值 最大值   看你模拟的数据貌似是  1-5 这个区间

1. Sub x()
   
2. Dim ar, x, y, br(1 To 65000, 1 To 1)
   
3. ar = Range("a1:c" & [a65500].End(3).Row): r = UBound(ar)
   
4.   For x = 1 To r
   
5.     For y = 1 To 3
   
6.        ar(x, y) = Application.Median(5, Int((ar(x, y) - 1) / 12) + 1, 1)
   
7.     Next
   
8.   Next
   
9.   For Z = 1 To r
   
10.     br(Z, 1) = ar(Z, 1) & "=" & ar(Z, 2) & "=" & ar(Z, 3)
    
11.   Next
    
12.     [e1].Resize(r) = br
    
13. End Sub
    

复制代码

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, p$
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 1)
   
5. For i = 1 To UBound(arr)
   
6.     p = ""
   
7.     For j = 1 To UBound(arr, 2)
   
8.         x = (Abs(arr(i, j)) - 1) \ 12 + 1
   
9.         p = p & "=" & x
   
10.     Next
    
11.     brr(i, 1) = Mid(p, 2)
    
12. Next
    
13. Range("e1").Resize(UBound(brr)) = brr
    
14. End Sub

复制代码