排序问题

hyefeifei

中间可以不是P，但必须是一位，右边数字在一到四位之间
简单解释一下，就是把你的字符串，转换为数字，加上一个小数，保证唯一
再用快速排序法排序，然后用字典取回，不用字典，在快递排序法里加个输出数组参数
存储位置也可，这里用字典法

1. Sub Test()
   
2.     Dim arr, i&, str As String, strte, d, brr()
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         str = Val(Right(arr(i, 1), Len(arr(i, 1)) - 2))
   
7.         str = str & Format(Right(arr(i, 1), Len(arr(i, 1)) - 3 - Len(str)), "0000")
   
8.         strte = Asc(Left(arr(i, 1), 1)) * Asc(Mid(arr(i, 1), 1, 1)) & Format(str, "0000000")   '至此把字符串转为数字
   
9.         strte = CDbl(strte)                     '转为双精度数字
   
10.         strte = strte + i / 10000              '加上一小数，保证数字唯一性
    
11.         d(strte) = arr(i, 1)                          '存到字典里
    
12.         arr(i, 1) = strte                              '把数组转为数值数组
    
13.     Next
    
14.     QSort arr                                        '快速排序
    
15.     ReDim brr(1 To UBound(arr), 0)
    
16.     For i = 1 To UBound(arr)              '取回排序结果
    
17.         brr(i, 0) = d(arr(i, 1))
    
18.     Next
    
19.     Range("c2").Resize(UBound(arr)) = brr
    
20. End Sub
    
21. '快速排序法（当然可用其他如冒泡之类），如主程序不用字典，可在此排序法上加一输出参数，存储元素位置
    
22. Sub QSort(var As Variant, Optional iLeft As Long, Optional iRight As Long)
    
23.     Dim i&, j&, vTemp1, vTemp2, iMid&, Temp
    
24.     If IsMissing(iLeft) Then iLeft = LBound(var)
    
25.     If IsMissing(iRight) Then iRight = UBound(var)
    
26.     If iLeft < iRight Then
    
27.         iMid = (iLeft + iRight) \ 2
    
28.         vTemp1 = var(iMid, 1)
    
29.         i = iLeft
    
30.         j = iRight
    
31.         Do
    
32.             vTemp2 = var(i, 1)
    
33.             Do While vTemp2 < vTemp1
    
34.                 i = i + 1
    
35.                 vTemp2 = var(i, 1)
    
36.             Loop
    
37.             vTemp2 = var(j, 1)
    
38.             Do While vTemp2 > vTemp1
    
39.                 j = j - 1
    
40.                 vTemp2 = var(j, 1)
    
41.             Loop
    
42.             If i <= j Then
    
43.                 Temp = var(i, 1): var(i, 1) = var(j, 1): var(j, 1) = Temp
    
44.                 i = i + 1
    
45.                 j = j - 1
    
46.             End If
    
47.         Loop Until i > j
    
48.         Call QSort(var, iLeft, j)
    
49.         Call QSort(var, i, iRight)
    
50.     End If
    
51. End Sub
    

复制代码

排序.rar (12.49 KB, 下载次数: 12)

2013-12-1 21:09 上传

点击文件名下载附件

czr0373

hyefeifei 发表于 2013-12-1 21:09
中间可以不是P，但必须是一位，右边数字在一到四位之间
简单解释一下，就是把你的字符串，转换为数字，加上 ...

好象是原列复制，，没有做任何排序操作！！！

hyefeifei

呵，不好意思，没做测试就传了上去，错在那个排序程序（Qsort),已经修正好了。
简单再说几句，思路很简单，主程序就是把：
                                       

HH12P132

HH12P32

HH141P21

HH36-12

JH17P32

JH22-42

这6个字符串，转化为：

51840120132.0001

51840120032.0002

51841410021.0003

51840360012.0004

54760170032.0005

54760220042.0006

这6个数字，至此，对6个数排序，你应该没问题了吧
如果数据不多，你可换个容易理解的冒泡排序，对数字排序。
附件如下：
排序.rar (11.33 KB, 下载次数: 7)

2013-12-3 08:15 上传

点击文件名下载附件

czr0373

hyefeifei 发表于 2013-12-3 08:15
呵，不好意思，没做测试就传了上去，错在那个排序程序（Qsort),已经修正好了。
简单再说几句，思路很简单， ...

过程我可能还需要学习理解一下，
现在结果依然是复制，没有操作！

czr0373

hyefeifei 发表于 2013-12-3 08:15
呵，不好意思，没做测试就传了上去，错在那个排序程序（Qsort),已经修正好了。
简单再说几句，思路很简单， ...

不好意思，我看错了，还是做了排序，，
但我的意思是，大分为两类，
即P在前，-在后，
在此基础上P类按升序排，-类也按升序排
排后的结果是：
HH12P132
HH12P32
HH141P21
JH17P32
HH36-12
JH22-42

Zamyi

1. Sub test()
   
2. Dim a(), w() As Long
   
3. r = Range("a2", [a65536].End(3))
   
4. ReDim a(1 To UBound(r), 1 To 4)
   
5. With CreateObject("VBSCRIPT.REGEXP")
   
6.   .Pattern = "(\D+)(\d+)(\D+)(\d+)"
   
7.   For i = 1 To UBound(r)
   
8.     t = Split(.Replace(r(i, 1), "$1 $2 $3 $4"))
   
9.     a(i, 1) = t(0)
   
10.     a(i, 2) = Val(t(1))
    
11.     a(i, 3) = (t(2))
    
12.     a(i, 4) = (t(3))
    
13.   Next
    
14. End With
    
15. ZSort a, w, 3, 1, 1, 0, 2, 0, 4, 0
    
16. ReDim a(1 To UBound(r), 1 To 1)
    
17. For i = 1 To UBound(r)
    
18.   a(i, 1) = r(w(i), 1)
    
19. Next
    
20. [c2].Resize(UBound(r)) = a
    
21. End Sub

复制代码

czr0373

Zamyi 发表于 2013-12-3 11:08

子过程或函数未定义

yjh_27

czr0373 发表于 2013-12-3 12:00
子过程或函数未定义

在6L 啊。
~~

czr0373

Zamyi 发表于 2013-11-26 10:42
二维数组排序的精髓只是对其记录的位置进行排序，排序过程中原数组都没有动，可以称之为“虚拟排序”吧。 ...

这里面没有把“P”和“-”分成两类来排，我意思是“P”类在前，“-”类的在后

czr0373

yjh_27 发表于 2013-12-3 12:23
在6L 啊。
~~

没有问题的，万分感谢！！