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

aoe1981 · 发表于 2015-1-3 00:38

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

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

rzqf · 发表于 2015-1-3 07:22

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

rzqf · 发表于 2015-1-3 07:26

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 · 发表于 2015-1-3 07:52

终于成功了，谢谢大家，复制代码上来，和大家一起研究
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 · 发表于 2015-1-3 09:22

hlly888 · 发表于 2015-1-3 09:30

请看附件

hlly888 · 发表于 2015-1-3 09:32

0.02秒

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

aoe1981 · 发表于 2015-1-3 11:10

修改后的代码如下：

Option Explicit
Public Sub PaiXu1()
Dim arr, n&, cs_max%, i&, j&, j1%, k&, k1%, m%, s1, s2, gd, jg, t#
t = Timer
n = Cells(Rows.Count, 1).End(xlUp).Row
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
jg = arr '记录原始结果
ReDim cs(1 To n): cs_max = 0
For i = 1 To n '自动检测最大层数
cs(i) = Len(arr(i, 1)) - Len(Replace(arr(i, 1), "-", "")) + 1
If cs_max < cs(i) Then cs_max = cs(i)
Next i
For i = 1 To n '统一编码层数
m = cs_max - cs(i)
arr(i, 1) = arr(i, 1) & String(m, "-")
Next i
ReDim ws_max(1 To cs_max), ws(1 To cs_max), brr(1 To n) '记录每一层位数最大值
For i = 1 To cs_max '每一层位数最大值初始化
ws_max(i) = 0
Next i
For i = 1 To n
brr(i) = Split(arr(i, 1), "-")
For j = 1 To cs_max
ws(j) = Len(brr(i)(j - 1))
If ws(j) > ws_max(j) Then ws_max(j) = ws(j)
Next j
Next i
ReDim gsf$(1 To cs_max), arr(1 To n, 1 To 1) '生成格式符、清空arr数组
For i = 1 To cs_max
gsf(i) = String(ws_max(i), "0")
Next i
For i = 1 To n '统一每层位数并重新连接
For j = 1 To cs_max
arr(i, 1) = arr(i, 1) & Format(Val(brr(i)(j - 1)), gsf(j))
Next j
Next i
For i = 1 To n - 1 '冒泡排序，一步到位
For j = i + 1 To n
If Val(arr(j, 1)) < Val(arr(i, 1)) Then
gd = jg(j, 1): jg(j, 1) = jg(i, 1): jg(i, 1) = gd
gd = arr(j, 1): arr(j, 1) = arr(i, 1): arr(i, 1) = gd
End If
Next j
Next i
Range("c:c").ClearContents: Range("c1").Resize(n) = jg: Range("d1") = "用时：" & Format(Timer - t, "0.0000") & "秒。"
End Sub