如何在内存中对二维数组进行排名

aroffice

因需要写一个小程序要用到排名，数组是通过前面的程序计算出来的，在中间部分需要进行排名，然后应用排名继续计算
有没有办法解决在数组中直接进行排名。
附件是随机生成数据来模拟进行的，请各位大师指点！ 数组排名.rar (10 KB, 下载次数: 25)

2015-1-4 13:40 上传

点击文件名下载附件

Sub test()
temp = Sheet1.Range("A2:C51").Value
'对二维数组进行排名，不用写入工作表的方法

temp = szpm(temp, 2, 1, 3)

Sheet1.Range("D2:F51") = temp

End Sub
Private Function szpm(sz, fl As Integer, cj As Integer, mc As Integer)

    Dim xbmin As Integer, xbmax As Integer, r1 As Integer, r2 As Integer
    On Error Resume Next
    r1 = UBound(sz, 2)
    If Err.Number <> 0 Then Exit Function
    On Error GoTo 0
    rl = 0
    xbmax = UBound(sz, 1)
    xbmin = LBound(sz, 1)
    If fl <= UBound(sz, 2) And fl >= LBound(sz, 2) And cj <= UBound(sz, 2) And cj >= LBound(sz, 2) And mc <= UBound(sz, 2) And mc >= LBound(sz, 2) Then
        For r1 = xbmin To xbmax
            sz(r1, mc) = 1
            For r2 = xbmin To xbmax
                If sz(r1, fl) = sz(r2, fl) And sz(r1, cj) < sz(r2, cj) Then sz(r1, mc) = sz(r1, mc) + 1
            Next r2
        Next r1
        szpm = sz
    End If

End Function

aroffice

更新了一下，是分类排名

wj2368

....................................

aroffice

wj2368 发表于 2015-1-4 13:53
....................................

谢谢回复，
请给解释一下么？
另外是需要名次，而不是排序，
更新了一下，是分类排名！

yjh_27

aroffice 发表于 2015-1-4 14:10
谢谢
请给解释一下么？
另外更新了一下，是分类排名！

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

aroffice

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

不是排序，而是取名次

yjh_27

aroffice 发表于 2015-1-4 14:14
不是排序，而是取名次

含排名次
37L 第一例就是排名次

bluexuemei

如果积分相同，怎么处理？

1. Sub Rankdata()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Dim y, ojs As Object
   
4.     Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
5.     ojs.eval ("def aa(aa) $aa=aa end")
   
6.     y = ojs.Run("aa", Sheet1.Range("b2", [d2].End(4)).Value)
   
7.     y = ojs.eval("h=Hash.new{[]};$aa.each{|x|h[x[0]]<<=x[2]};$aa.map{|x|h[x[0]].select{|i|i>x[2]}.size+1}.zip")
   
8.     Sheet1.[e2].Resize(UBound(y) + 1) = y
   
9.     Set ojs = Nothing
   
10.     'Stop
    
11. End Sub

复制代码

wj2368

aroffice 发表于 2015-1-4 14:10
谢谢回复，
请给解释一下么？
另外是需要名次，而不是排序，

.............................................

yjh_27

aroffice 发表于 2015-1-4 14:14
不是排序，而是取名次

参见附件。