单元格内数据是逗号隔开的，宏如何实现给单元格内数据由小到大排序

arcticstar

单元格内数据是逗号隔开的，宏如何实现给单元格内数据由小到大排序：如：

R11,R15,R18,R19,R20,R21,R22,R23,R24,R26,R3,R34,R4,R49,R5,R6,R7,R9

jsxjd

数字部分最大值有限制吗？
是否总是一位字母？
上传代表性的文档！

arcticstar

jsxjd 发表于 2015-4-23 16:05
数字部分最大值有限制吗？
是否总是一位字母？
上传代表性的文档！

在B列显示排序后的数据.zip (7.09 KB, 下载次数: 65)

2015-4-23 16:08 上传

点击文件名下载附件

如何实现在B列显示排序后的数据

Zamyi

如果数据不大于100：

1. Function f(s)
   
2. Dim a(100)
   
3. For Each c In Split(s, ",")
   
4.   a(Mid(c, 2)) = "," & c
   
5. Next
   
6. f = Mid(Join(a, ""), 2)
   
7. End Function

复制代码

jsxjd

arcticstar 发表于 2015-4-23 16:09
如何实现在B列显示排序后的数据

1. Private Sub CommandButton1_Click()
   
2.     Dim Code#(1000)
   
3.     [B:B].ClearContents
   
4.     For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
   
5.         s = Trim(c.Value)
   
6.         If Len(s) > 0 Then
   
7.             x = Split(s, ",")
   
8.             If UBound(x) = LBound(x) Then
   
9.                 c.Offset(, 1) = s
   
10.             Else
    
11.                 n = 1
    
12.                 For i = 1 To 9
    
13.                     If (Asc(Mid(s, i, 1)) < 48) Or (Asc(Mid(s, i, 1)) > 57) Then n = n + 1 Else Exit For
    
14.                 Next
    
15.                
    
16.                 For i = LBound(x) To UBound(x): Code(i) = CInt(Mid(x(i), n)): Next
    
17.                 For i = LBound(x) To UBound(x) - 1
    
18.                     For j = i + 1 To UBound(x)
    
19.                         If Code(i) > Code(j) Then t = Code(j): Code(j) = Code(i): Code(i) = t
    
20.                     Next
    
21.                 Next
    
22.                 For i = LBound(x) To UBound(x): x(i) = Left(s, n - 1) & Code(i): Next
    
23.                 c.Offset(, 1) = Join(x, ",")
    
24.             End If
    
25.         End If
    
26.     Next
    
27. End Sub
    

复制代码

jsxjd

在B列显示排序后的数据.rar (12.43 KB, 下载次数: 61)

2015-4-23 16:49 上传

点击文件名下载附件

Zamyi

Zamyi 发表于 2015-4-23 16:26
如果数据不大于100：

一楼内容无问题

笑着...两年过去

Sub test()
    ReDim arr(1 To 99, 1 To 1)
    a = Application.Substitute([a1], "R", Application.Rept(" ", 99))
    Do While (3 + i) * 90 < Len(a)
       i = i + 1
       arr(i, 1) = 1 * Application.Substitute(Trim(Mid(a, i * 99, 99)), " ,", "")
    Loop
    For j = 1 To i
        n = n & "R" & Application.Small(arr, j) & ","
    Next
    [a2] = Left(n, Len([a1]))
End Sub

jsxjd

这个代码简一点，效率不一定比前面高

1. Private Sub CommandButton1_Click()
   
2.     [B:B].ClearContents
   
3.     For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
   
4.         s = Trim(c.Value)
   
5.         If Len(s) > 0 Then
   
6.             x = Split(s, ",")
   
7.             If UBound(x) = LBound(x) Then
   
8.                 c.Offset(, 1) = s
   
9.             Else
   
10.                 n = 1
    
11.                 For i = 1 To 9
    
12.                     If (Asc(Mid(s, i, 1)) < 48) Or (Asc(Mid(s, i, 1)) > 57) Then n = n + 1 Else Exit For
    
13.                 Next
    
14.                
    
15.                 For i = LBound(x) To UBound(x) - 1
    
16.                     For j = i + 1 To UBound(x)
    
17.                         If CInt(Mid(x(i), n)) > CInt(Mid(x(j), n)) Then t = x(j): x(j) = x(i): x(i) = t
    
18.                     Next
    
19.                 Next
    
20.                 c.Offset(, 1) = Join(x, ",")
    
21.             End If
    
22.         End If
    
23.     Next
    
24. End Sub
    

复制代码

jsxjd

Zamyi 发表于 2015-4-23 16:52
一楼内容无问题

是这样变吧？
R11,R15,R18,R19,R20,R21,R22,R23,R24,R26,R3,R34,R4,R49,R5,R6,R7,R9

R3,R4,R5,R6,R7,R9,R11,R15,R18,R19,R20,R21,R22,R23,R24,R26,R34,R49