都来看看这个排序怎么实现，再来看看单位前面的量怎么提取

aoe1981

总体感觉代码效率太低，原因可能有二：
一是如果编码有几层，就反复几次使用“冒泡排序”遍历一次，“冒泡排序”本就效率不高，且重复几次的话，更低下了，被放大了……
二是在循环内部存在文本连接符&的运算，据说这个运算本身是很慢的，很耗时的……

进一步的改进恐怕得香川这样的大师来做了，香川的“希尔排序”、“快速排序”，总是感觉太复杂，难以熟稔运用……

rzqf

为什么都不能将“A”列的数值按照“B”列的顺序排列呢

rzqf

aoe1981 发表于 2015-1-3 00:27
根据以下指点：
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1176846&pid=8024 ...

这些都不能将“A”列的数值按照“B”列的顺序排列，应该是1-1, 1-2, 1-3的顺序才可以的

rzqf

终于成功了，谢谢大家，复制代码上来，和大家一起研究
Sub mesort()
Application.ScreenUpdating = False
Dim RegEx, rng, i, t
Sheets("1").Activate
Set rng = Range("c2", [c65536].End(3))
Set RegEx = CreateObject("VBSCRIPT.REGEXP")
For i = 2 To [c65536].End(3).Row
   RegEx.Global = True
   RegEx.Pattern = "[^0-9/^-]"
   t = RegEx.Replace(Cells(i, 3), "") & Chr(9)
   Cells(i, 3) = Format(Split(t, "-")(0), "000") & Format(Split(t, "-")(1), "000") & "&" & Cells(i, 3)
Next
rng.Sort Key1:=[c2], Order1:=1, Header:=xlNo
For i = 2 To [c65536].End(3).Row
    Cells(i, 3) = Split(Cells(i, 3), "&")(1)
Next
Set RegEx = Nothing
Application.ScreenUpdating = True
End Sub

yuwd3

hlly888

请看附件                        

hlly888

0.02秒

按B列排序.zip (30.49 KB, 下载次数: 48)

2015-1-3 09:30 上传

点击文件名下载附件

aoe1981

修改后的代码如下：

1. Option Explicit
   
2. Public Sub PaiXu1()
   
3. Dim arr, n&, cs_max%, i&, j&, j1%, k&, k1%, m%, s1, s2, gd, jg, t#
   
4.     t = Timer
   
5.     n = Cells(Rows.Count, 1).End(xlUp).Row
   
6.     If n > 1 Then arr = Range("a1:a" & n).Value Else ReDim arr(1 To 1, 1 To 1): arr(1, 1) = Range("a1").Value
   
7.     jg = arr '记录原始结果
   
8.    
   
9.    
   
10.     ReDim cs(1 To n): cs_max = 0
    
11.     For i = 1 To n '自动检测最大层数
    
12.         cs(i) = Len(arr(i, 1)) - Len(Replace(arr(i, 1), "-", "")) + 1
    
13.         If cs_max < cs(i) Then cs_max = cs(i)
    
14.     Next i
    
15.    
    
16.    
    
17.     For i = 1 To n '统一编码层数
    
18.         m = cs_max - cs(i)
    
19.         arr(i, 1) = arr(i, 1) & String(m, "-")
    
20.     Next i
    
21.    
    
22.    
    
23.     ReDim ws_max(1 To cs_max), ws(1 To cs_max), brr(1 To n) '记录每一层位数最大值
    
24.     For i = 1 To cs_max '每一层位数最大值初始化
    
25.         ws_max(i) = 0
    
26.     Next i
    
27.     For i = 1 To n
    
28.         brr(i) = Split(arr(i, 1), "-")
    
29.         For j = 1 To cs_max
    
30.             ws(j) = Len(brr(i)(j - 1))
    
31.             If ws(j) > ws_max(j) Then ws_max(j) = ws(j)
    
32.         Next j
    
33.     Next i
    
34.    
    
35.    
    
36.     ReDim gsf$(1 To cs_max), arr(1 To n, 1 To 1) '生成格式符、清空arr数组
    
37.     For i = 1 To cs_max
    
38.         gsf(i) = String(ws_max(i), "0")
    
39.     Next i
    
40.     For i = 1 To n '统一每层位数并重新连接
    
41.         For j = 1 To cs_max
    
42.             arr(i, 1) = arr(i, 1) & Format(Val(brr(i)(j - 1)), gsf(j))
    
43.         Next j
    
44.     Next i
    
45.    
    
46.    
    
47.     For i = 1 To n - 1 '冒泡排序，一步到位
    
48.         For j = i + 1 To n
    
49.             If Val(arr(j, 1)) < Val(arr(i, 1)) Then
    
50.                 gd = jg(j, 1): jg(j, 1) = jg(i, 1): jg(i, 1) = gd
    
51.                 gd = arr(j, 1): arr(j, 1) = arr(i, 1): arr(i, 1) = gd
    
52.             End If
    
53.         Next j
    
54.     Next i
    
55.     Range("c:c").ClearContents: Range("c1").Resize(n) = jg: Range("d1") = "用时：" & Format(Timer - t, "0.0000") & "秒。"
    
56. End Sub
    

复制代码

可以自动检测层数，及每层位数，适应性强，效率比前次排序高。

aoe1981

新的附件如下：
号导入（aoe1981）含两种排序结果.rar (24.08 KB, 下载次数: 70)

2015-1-3 11:11 上传

点击文件名下载附件

效果图一角：

aoe1981

这个排序处理比前面简单了，只需做一次冒泡排序即可……

任意修改层数、每层位数均不受影响，一组测试图如下：