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

aoe1981

附件中有一段关于产生格式符的有益测试，标记下：

1. Sub ss()
   
2.     a = ""
   
3.     b = Val(a)
   
4.     c = Format(b, "0000")
   
5. End Sub

复制代码

hlly888

aoe1981 发表于 2015-1-3 11:16
这个排序处理比前面简单了，只需做一次冒泡排序即可……

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

只是针对本附件，通用不是不可能。

hlly888

通用


按B列排序2.zip (30.95 KB, 下载次数: 39)

2015-1-3 12:21 上传

点击文件名下载附件

yuwd3

hlly888 发表于 2015-1-3 12:21
通用

有个问题：在
1-2-3
1-2-3-1
时排序是：
1-2-3-1
1-2-3

yuwd3

根据hlly888程序修改完善

1. Sub 排序2() 'hlly888
   
2. Range("a1:gz65536").ClearContents
   
3. Application.ScreenUpdating = False
   
4. Dim arr, x&, i&, k%, da%, c, tim
   
5. tim = Timer
   
6. x = Sheet1.Range("a65536").End(3).Row
   
7. arr = Sheet1.Range("a1:a" & x)
   
8. ReDim brr(1 To x, 1 To 10000)
   
9.     For i = 1 To x
   
10.         c = Split(arr(i, 1), "-")
    
11.         If UBound(c) > da Then da = UBound(c)
    
12.         For k = 0 To UBound(c)
    
13.             brr(i, k + 1) = c(k)
    
14.         Next
    
15.     Next
    
16.     [a1].Resize(x, 1) = arr
    
17.     [b1].Resize(x, da + 1) = brr
    
18.     [a1].CurrentRegion.SpecialCells(xlCellTypeBlanks) = 0
    
19.     For j = da To 2 Step -1
    
20.         Cells(1, 1).CurrentRegion.Sort Key1:=Cells(1, j), Order1:=xlAscending, Header:=xlNo
    
21.     Next
    
22.     [b1].Resize(x, da + 1).ClearContents
    
23. [c1] = Format(Timer - tim, "0.00") & "秒"
    
24. Application.ScreenUpdating = True
    
25. End Sub
    

复制代码

yuwd3

按B列排序2.zip (33.16 KB, 下载次数: 44)

2015-1-3 13:37 上传

点击文件名下载附件

bluexuemei

1. Sub sortdata提取文本()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Dim y, ojs As Object
   
4.     Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
5.     ojs.eval ("def aa(aa) $aa=aa.flatten end")
   
6.     y = ojs.Run("aa", Sheet1.Range("A1", [a1].End(4)).Value)
   
7.     y = ojs.eval("$aa.sort_by{|x|x.split('-').map(&:to_i)}.zip")
   
8.     Sheet1.[g1].Resize(UBound(y) + 1).NumberFormatLocal = "@"
   
9.     Sheet1.[g1].Resize(UBound(y) + 1) = y
   
10.     Set ojs = Nothing
    
11.     'Stop
    
12. End Sub
    

复制代码

yjh_27

就是大纲排序

qy1219no2

我也来冒个泡，不过层级控制在10层以内没有问题（当然也可稍作修改代码即可实现层级的扩展），每级最大编号9999（也可对代码稍作修改，即可扩展最大编号）

1. Sub txtNumIdSort()
   
2.     Dim sj() As String, k&, i&, tmp() As String, arrSort As Object
   
3.     nR = [a65536].End(xlUp).Row
   
4.     arr = [a1].Resize(nR, 1)
   
5.     Set arrSort = CreateObject("System.Collections.ArrayList")
   
6.     ReDim tmp(9), sj(nR - 1, 0)
   
7.     For i = 1 To nR
   
8.         brr = Split(arr(i, 1), "-")
   
9.         For k = 0 To 9
   
10.             If k <= UBound(brr) Then
    
11.                 tmp(k) = Format(brr(k), "0000")
    
12.             Else
    
13.                 tmp(k) = "0000"
    
14.             End If
    
15.         Next
    
16.         arrSort.Add Join(tmp, "-")
    
17.     Next
    
18.     arrSort.Sort
    
19.     For i = 0 To nR - 1
    
20.         brr = Split(arrSort(i), "-")
    
21.         For k = 0 To 9
    
22.             sj(i, 0) = sj(i, 0) & IIf(brr(k) = "0000", "", "-" & Val(brr(k)))
    
23.         Next
    
24.         sj(i, 0) = Mid(sj(i, 0), 2, 99)
    
25.     Next
    
26.     [c1].Resize(nR, 1) = sj
    
27. End Sub

复制代码

aoe1981

qy1219no2 发表于 2015-1-3 15:51
我也来冒个泡，不过层级控制在10层以内没有问题（当然也可稍作修改代码即可实现层级的扩展），每级最大编号 ...

对那句不太懂……

感觉核心的排序语句是这句：arrSort.Sort

之前是数据改造，之后是数据还原……

不知，可有猜中？