不同数组之间排序问题

11139832

假设有4个试验，它们的顺序是4,1,3,2。 现在想让它们排成1,2,3,4的升序，该如何做？

看过VBA 常用排序，但好像不适用这种情况？

有高手提供点思路吗？

sz_wap

G2单元格输入：=IF(A2>0,A2,G1+0.00001)
下拉复制，按G列排序就行了

yjh_27

参见附件。

bluexuemei

1. Sub test()
   
2.     '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
4.     ojs.eval ("def aa(aa) $aa=aa end")
   
5.     y = ojs.Run("aa", Sheet1.Range("a2", Sheet1.[f2].End(4)).Value)
   
6.     arr = ojs.eval("$aa.slice_before{|x|x[0]}.to_a.sort_by{|x|x[0][0]}.flatten(1)")
   
7.     Sheet2.[a2].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
   
8.     'Stop
   
9. End Sub

复制代码

香川群子

基础操作，用2个辅助列即可。
① 插入A、B辅助列
② A列中写入分区序号(数组号 如 4、3、1、2)
③ B列中写入排序前的原始序号(自然数序列 1、2、3、4、……)

然后
④ 选择工作表排序，A列为第1排序参数、B列为第2排序参数

这以后，可以随时返回原始顺序……按照B列排序即可。


以上……呵呵。

11139832

sz_wap 发表于 2014-12-25 11:55
G2单元格输入：=IF(A2>0,A2,G1+0.00001)
下拉复制，按G列排序就行了

这个办法很巧妙，如果没有3楼的程序，我觉得你的办法最好。

11139832

yjh_27 发表于 2014-12-25 12:27
参见附件。

1800多行的排序代码很强大。佩服！学习中。。。

11139832

bluexuemei 发表于 2014-12-25 12:33

公司不让装插件，所以这个方法我没有试过。

yjh_27

11139832 发表于 2014-12-25 13:30
1800多行的排序代码很强大。佩服！学习中。。。

多Key数组排序(分类、统计、重复处理)-自定义函数
http://club.excelhome.net/thread-1090007-1-1.html

yaozong

字典排序

1. Sub yy()
   
2. Dim d, arr, i&, j&, k&, m&, n&, x&, y&, r&
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheet1
   
5.    r = .Cells(Rows.Count, 6).End(3).Row
   
6.   arr = .Range("a1:g" & r).Value
   
7. End With
   
8. x = UBound(arr, 2): y = UBound(arr)
   
9. For i = 2 To y
   
10.   If arr(i, 1) = "" Then
    
11.      arr(i, x) = arr(i - 1, 1): arr(i, x) = arr(i - 1, x)
    
12.   Else
    
13.      arr(i, x) = arr(i, 1)
    
14.   End If
    
15.   d(arr(i, x)) = ""
    
16. Next
    
17. ReDim brr(1 To y - 1, 1 To x)
    
18. For i = 1 To d.Count
    
19.    n = Application.Small(d.keys, i)
    
20.    For j = 2 To y
    
21.       If arr(j, x) = n Then
    
22.          m = m + 1
    
23.          For k = 1 To x - 1
    
24.             brr(m, k) = arr(j, k)
    
25.          Next
    
26.       End If
    
27.    Next
    
28. Next
    
29. With Sheet2
    
30.    .[a1].CurrentRegion.ClearContents
    
31.    .[a2].Resize(y - 1, x - 1) = brr
    
32.    .[a1] = Sheet1.[a1].Value
    
33. End With
    
34. Set d = Nothing
    
35. End Sub

复制代码