[已解决]排序的问题

windimi007

huangcaiguang 发表于 2013-8-11 12:04
只不过没有严格意义的不用辅助列、分列了就不是在原列上处理数据了。。。。
开始想分类汇总再自定义序列的 ...

学习了，排序那个选项不经常用，以后得多进去看看才是，O(∩_∩)O哈哈~{:2012:}

zjdh

给你个VBA的
排序.rar (13.95 KB, 下载次数: 13)

2013-8-11 14:29 上传

点击文件名下载附件

cxloen

zjdh 发表于 2013-8-11 14:29
给你个VBA的

谢谢了，非常不错，有个问题，如果排序的是“汉字+数字”组合，是否需要增加字典来定义数组，
数组里汉字是未知的，需要从需要排序的内容里提取汉字组合，
如果做成XLA加载到当前要排序的列，是否还要加上要排序的列的输入选项

zjdh

cxloen 发表于 2013-8-11 15:34
谢谢了，非常不错，有个问题，如果排序的是“汉字+数字”组合，是否需要增加字典来定义数组，
数组里汉字 ...

当然需要！

上清宫主

这问题如果用VBA的话，感觉还是象前面做的利用单元格区域分列、排序，方便简洁

cxloen

上清宫主 发表于 2013-8-11 20:29
这问题如果用VBA的话，感觉还是象前面做的利用单元格区域分列、排序，方便简洁

你就说我在收集工具了,只是想做多几个工具放在加载宏里,方便,也增强了比尔的EXCEL功能

香川群子

楼主提出了一个看似简单，实则不简单的问题。

用辅助列分列来做感觉有些麻烦，所以楼主不喜欢 →  这个可以理解。

但是直接操作也不是件容易的事。


如果既要结果简单明了不使用辅助列，
又要避免麻烦的操作……那就只有VBA了。


但是很意外地发现，VBA也不是简单几句代码就可以搞定的，需要相当的功力。

呵呵。

可以想到的思路是：
1. 获取原始数据读入数组
2. 用正则分别提取字母(非数字)和数字，然后数字整形统一长度以便比较。
3. 用代码排序
4. 输出排序后的结果

其中2、3过程都需要另写函数过程进行处理。


呵呵。。。

香川群子

1. Sub Test() 'by kagawa
   
2.     Static k
   
3.     arr = [a1].CurrentRegion
   
4.     m = UBound(arr)
   
5.     For i = 1 To m
   
6.         If Len(arr(i, 1)) > n Then n = Len(arr(i, 1))
   
7.     Next
   
8.    
   
9.     ReDim brr(1 To m, 1 To 2)
   
10.     For i = 1 To m
    
11.         brr(i, 1) = arr(i, 1)
    
12.         brr(i, 2) = Reform(arr(i, 1), n - 1)
    
13.     Next
    
14.    
    
15.     Call ShellSort5(brr, 2, 1)
    
16.    
    
17.     [e1].CurrentRegion = ""
    
18.     If k Then k = 0 Else k = 1
    
19.     [e1].Resize(m, k + 1) = brr '此处选择仅输出排序结果1列，或连同辅助列的2列一起输出。
    
20.    
    
21. End Sub
    
22. Function Reform(txt, Optional n = 4)
    
23.     With CreateObject("VBScript.RegExp")
    
24.         .Global = True
    
25.         .Pattern = "\d"
    
26.         t1 = .Replace(txt, "")
    
27.         .Pattern = "\D"
    
28.         t2 = .Replace(txt, "")
    
29.     End With
    
30.     Reform = t1 & Right(String(n, "0") & t2, n)
    
31. End Function
    
32. Sub ShellSort5(trr, x, y) 'n=5
    
33.     Dim h&, i&, j&, l&, u&, t1, t2
    
34.                   
    
35.     l = LBound(trr): u = UBound(trr): h = u
    
36.     Do
    
37.         h = (h \ 5) * 2 + 1
    
38.         For i = l + h To u
    
39.             t1 = trr(i, x): t2 = trr(i, y)
    
40.             For j = i - h To l Step -h
    
41.                 If trr(j, x) < t1 Then Exit For
    
42.                 trr(j + h, x) = trr(j, x): trr(j + h, y) = trr(j, y)
    
43.             Next
    
44.             trr(j + h, x) = t1: trr(j + h, y) = t2
    
45.         Next
    
46.     Loop Until h = 1
    
47. End Sub

复制代码

cxloen

香川群子 发表于 2013-8-12 10:19

高手在民间，厉害啊，能实现除表头外的全部行按此列排序么