[已解决]请教---vba把数字单元格的字符按小大批量排序

yslvictor

请教各位大师用vba代码把数字单元格的字符按小大批量排序，如图：

vba字符大小排序.rar (2.26 KB, 下载次数: 21)

2013-11-23 15:31 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2013-11-23 16:44

1. 
   
2. Sub test()
   
3.   Dim arr(), i&, tmp As String, j As Byte, brr(1 To 3), k As Byte
   
4.   arr = Range("C14:C38").Value
   
5.   For i = 1 To UBound(arr)
   
6.     For j = 1 To Len(arr(i, 1))
   
7.       brr(j) = Mid(arr(i, 1), j, 1)
   
8.     Next
   
9.     For k = 2 To UBound(brr)
   
10.       For j = 1 To UBound(brr) - 1
    
11.         If brr(j) > brr(j + 1) Then
    
12.           tmp = brr(j)
    
13.           brr(j) = brr(j + 1)
    
14.           brr(j + 1) = tmp
    
15.         End If
    
16.       Next
    
17.     Next
    
18.     arr(i, 1) = "'" & Join(brr, "")
    
19.   Next
    
20.   Range("D14:D38") = arr
    
21. End Sub

复制代码

跳转到最佳答案楼层

as0810114

D14数组公式，下拉

1. =TEXT(SUM(SMALL(--MID(C14,ROW($1:$3),1),ROW($1:$3))*{100;10;1}),"000")

复制代码

byhdch

1. Sub test()
   
2. Dim i As Integer, j%, k%, x%, m%, n%
   
3. Dim arr(1 To 3, 1 To 1)
   
4. For x = 14 To 38
   
5. k = 0
   
6. For n = 1 To Len(Cells(x, 3))
   
7. k = k + 1
   
8. arr(k, 1) = Mid(Cells(x, 3), n, 1)
   
9. Next n
   
10. For i = 1 To UBound(arr)
    
11. For j = i + 1 To UBound(arr)
    
12. If arr(i, 1) > arr(j, 1) Then
    
13. m = arr(i, 1)
    
14. arr(i, 1) = arr(j, 1)
    
15. arr(j, 1) = m
    
16. End If
    
17. Next
    
18. Next
    
19. Cells(x, 4) = "'" & Join(Application.Transpose(arr), "")
    
20. Next x
    
21. End Sub
    

复制代码

byhdch

是否要求效果：
vba字符大小排序.rar (12.06 KB, 下载次数: 17)

2013-11-23 16:26 上传

点击文件名下载附件

xdragon

1. 
   
2. Sub test()
   
3.   Dim arr(), i&, tmp As String, j As Byte, brr(1 To 3), k As Byte
   
4.   arr = Range("C14:C38").Value
   
5.   For i = 1 To UBound(arr)
   
6.     For j = 1 To Len(arr(i, 1))
   
7.       brr(j) = Mid(arr(i, 1), j, 1)
   
8.     Next
   
9.     For k = 2 To UBound(brr)
   
10.       For j = 1 To UBound(brr) - 1
    
11.         If brr(j) > brr(j + 1) Then
    
12.           tmp = brr(j)
    
13.           brr(j) = brr(j + 1)
    
14.           brr(j + 1) = tmp
    
15.         End If
    
16.       Next
    
17.     Next
    
18.     arr(i, 1) = "'" & Join(brr, "")
    
19.   Next
    
20.   Range("D14:D38") = arr
    
21. End Sub

复制代码

yslvictor

都是我要的代码，谢谢二位论坛老师，感觉5楼的运算速度稍快点。