[已解决]排序的问题

cxloen

在不增加辅助列的情况下，如何把A例数据排序成c列的顺序（用技巧法最好），或者VBA形式

最佳答案

月排行榜 / 总排行榜

香川群子

2013-8-12 10:19

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

复制代码

跳转到最佳答案楼层

冠军欧洲2010

用了辅助列。

cxloen

期待更好的解法

as0810114

cxloen 发表于 2013-8-11 10:02
期待更好的解法

已经这么多人下载，都没人回答，你这个要求不用辅助列，纯技巧做不到。

cxloen

excel不强大，什么时候去找比尔，或许小妖能解

cxloen

as0810114 发表于 2013-8-11 10:17
已经这么多人下载，都没人回答，你这个要求不用辅助列，纯技巧做不到。

以前看到小妖解过，忘了是哪里看到的

心正意诚身修

冠军给你做出来了,就算达不到你要的效果,.起码你也应该说声谢谢,再问有别的解法没有嘛.一点尊重都不懂.你去找小妖吧.不会有人给你做的

心正意诚身修

当然你也可以去找BILL,让他重新为你设计一个.

cxloen

心正意诚身修 发表于 2013-8-11 10:23
冠军给你做出来了,就算达不到你要的效果,.起码你也应该说声谢谢,再问有别的解法没有嘛.一点尊重都不懂.你去 ...

我评了最佳了就没人来这个贴帮我了，就相当于关闭了，我还在线继续等

cxloen

冠军欧洲2010 发表于 2013-8-11 09:06
用了辅助列。

谢谢你的函数解法，想再多收集几种，老师请指点