非常有难度的字母+数字排序，自己想了两天了都不知道该怎么排序，请高手帮忙解答一下

wang8679506

C11

R3

C2

R12

C6

C110

R1

C9

R101

C1

R6

表中的排序要求：先按照ABCDEFG的顺序先分开，再排序字母后边的数字，字母最多5位，数字最多4位，怎么排序？用EXCEL自带的排序可以按照字母排序，但是数字排序不对。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim reg As New RegExp
   
5.   With reg
   
6.     .Global = True
   
7.     .Pattern = "([^\d]+)(\d+)"
   
8.   End With
   
9.   With Worksheets("sheet1")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     arr = .Range("a2:a" & r)
    
12.     ReDim brr(1 To UBound(arr), 1 To 2)
    
13.     For i = 1 To UBound(arr)
    
14.       Set mh = reg.Execute(arr(i, 1))
    
15.       If mh.Count > 0 Then
    
16.         brr(i, 1) = mh(0).SubMatches(0)
    
17.         brr(i, 2) = Val(mh(0).SubMatches(1))
    
18.       End If
    
19.     Next
    
20.     .Range("c2").Resize(UBound(brr), UBound(brr, 2)).Value = brr
    
21.     .Range("c2").Resize(UBound(brr), UBound(brr, 2)).Sort key1:=.Range("c2"), order1:=xlAscending, key2:=.Range("d2"), order2:=xlAscending, Header:=lxno
    
22.     brr = .Range("c2").Resize(UBound(brr), UBound(brr, 2))
    
23.     .Range("c2").Resize(UBound(brr), UBound(brr, 2)).Clear
    
24.     For i = 1 To UBound(brr)
    
25.       arr(i, 1) = brr(i, 1) & brr(i, 2)
    
26.     Next
    
27.     .Range("b2").Resize(UBound(arr), 1) = arr
    
28.    
    
29.   End With
    
30. End Sub
    

复制代码

microyip

这种情况只能添加辅助列来排，将所有值使用Format(值,"@0000")转换成统一格式后再排序，然后再清除辅助列

chxw68

通过辅助列排序的。

wang8679506

chxw68 发表于 2016-11-3 15:30
通过辅助列排序的。

恩恩，效果跟我想的一样，我再扩展一下，谢谢！

duquancai

附件，点击按钮》》》》

wang8679506

chxw68 发表于 2016-11-3 15:30

额，  我修改了之后后边的数值不会跟着前边的数值一起排序，能帮我看看怎么修改吗？麻烦你了！

chxw68

1. Sub test2()
   
2.   Dim r%, i%, j%, m%, n%
   
3.   Dim arr, brr
   
4.   Dim reg As New RegExp
   
5.   With reg
   
6.     .Global = True
   
7.     .Pattern = "([^\d]+)(\d+)"
   
8.   End With
   
9.   With Worksheets("sheet1")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     arr = .Range("a2:a" & r)
    
12.     ReDim brr(1 To UBound(arr), 1 To 1)
    
13.     For i = 1 To UBound(arr)
    
14.       Set mh = reg.Execute(arr(i, 1))
    
15.       If mh.Count > 0 Then
    
16.         ss = mh(0).SubMatches(0)
    
17.         s = 0
    
18.         For j = 1 To Len(ss)
    
19.           ch = Mid(ss, j, 1)
    
20.           ii = Asc(ch)
    
21.           s = s + ii * Application.Power(10, 10 - j)
    
22.         Next
    
23.         brr(i, 1) = s + Val(mh(0).SubMatches(1))
    
24.       End If
    
25.     Next
    
26.   End With
    
27.   For i = 1 To UBound(brr) - 1
    
28.     p = i
    
29.     For j = i + 1 To UBound(brr)
    
30.       If brr(p, 1) > brr(j, 1) Then
    
31.         p = j
    
32.       End If
    
33.     Next
    
34.     If p <> i Then
    
35.       temp = brr(i, 1)
    
36.       brr(i, 1) = brr(p, 1)
    
37.       brr(p, 1) = temp
    
38.       temp = arr(i, 1)
    
39.       arr(i, 1) = arr(p, 1)
    
40.       arr(p, 1) = temp
    
41.     End If
    
42.   Next
    
43.   With Worksheets("sheet1")
    
44.     .Range("b2").Resize(UBound(arr), 1) = arr
    
45.   End With
    
46. End Sub
    

复制代码

chxw68

这个题目比较新颖！又试着用直接计算每个字符的ASCII码写了一个，由于楼主提供的数据比较少，也比较单一，没法验证是否符合楼主要求，请楼主自己测试。

chxw68

修改好了。