数组排序篇！！！！！！！！！

bajifeng

个人一般用SMALL & LARGE

zeropww

mark一下，好东西

曾焱

感谢！学习！提升！

antique_star

最近工作需要，想了解一下数组的排序（不是指用excel的sort方法），于是硬着头皮研究了一下冒泡排序法，
但网上的案例多半是单列排序，可实际工作上基本上是二维数据库的整体排序。
于是经过变通，在单列冒泡法的基础上略做改动，即可直接在内存数组中完成排序。

废话少说，上代码：

1. Sub SortUP_HaoNai()
   
2. 
   
3. Dim DataResource() '定义数据源数组
   
4. DataResource = Sheets("数据源").[A2].Resize(19, 6).Value '读取数据源，可根据需要随便整些模拟数据
   
5. 
   
6. Dim Arr()
   
7. ReDim Arr(1 To UBound(DataResource), 1 To 2) '建立二列（排序关键字+原顺序的索引值）的二维数据用于排序
   
8. For I = 1 To UBound(DataResource)
   
9.   Arr(I, 1) = DataResource(I, 6) '本处排序关键字位于第6列
   
10.   Arr(I, 2) = I '记录原顺序索引值
    
11. Next
    
12. 
    
13. Dim TempDataKeyWord '建立临时变量存储排序过程中的关键字的值
    
14. Dim TempDataIndex   '建立临时变量存储排序过程中的关键字对应的索引值
    
15. 
    
16. For I = 1 To UBound(Arr) - 1 '冒泡排序法，对单列关键字排序的同时，对索引值也相应更新位置
    
17.   For J = I + 1 To UBound(Arr)
    
18.     If Arr(I, 1) > Arr(J, 1) Then '升序排列，如果要降序，直接将大于号换成小于号即可
    
19.       TempDataKeyWord = Arr(I, 1): TempDataIndex = Arr(I, 2)
    
20.       Arr(I, 1) = Arr(J, 1): Arr(I, 2) = Arr(J, 2)
    
21.       Arr(J, 1) = TempDataKeyWord: Arr(J, 2) = TempDataIndex
    
22.     End If
    
23.   Next
    
24. Next
    
25. 
    
26. Dim NewData() '定义排序后的新数组
    
27. NewData = [DataResource] '不想多写代码建立同样大小的二维矩阵，直接等同即建立同样大小的数组
    
28. For I = 1 To UBound(Arr) '再通过循环之前排好序的两列数据中索引值，将原数组重新按新顺序排列
    
29.   For J = 1 To UBound(DataResource, 2)
    
30.     NewData(I, J) = DataResource(Arr(I, 2), J)
    
31.   Next
    
32. Next
    
33. 
    
34. [A2].Resize(19, 6) = NewData() '输出数据
    
35. 
    
36. End Sub

复制代码

个人想法，仅供初学者套用与帮助理解。
欢迎大师指点！

lzqmsy

太好了,留个记号,学习方便

寒潮大冬瓜

楼主强大！能不能改造为自定义函数呢？那样的话希望在哪里用上就直接填入搞定……很方便！

lupo88

谢谢antique_star，代码简单明了，速度快，套用方便。

sluojianfei

这个是不是更快
Function sornum(arr)
    Dim rearr()
    ReDim rearr(1 To UBound(arr))
    For i = 1 To UBound(arr)
        rearr(i) = WorksheetFunction.Large(arr, i)
    Next
    sornum = rearr
End Function

高傲的鱼儿

感谢楼主分享

也淞归来

这整理得好，收藏了