求助: excel分区多条件排名

LIAOXUQIAN

老师好：

      想用VB对EXCEL数据进行分区多条件排名，请路过的大神出手帮忙指点，详见下图或附件，万分感谢！

蓝桥玄霜

排名的例子：

LIAOXUQIAN

蓝桥玄霜 发表于 2021-1-23 15:03
排名的例子：

非常感谢版主蓝桥玄霜老师的帮助，问题解决了，实在太神啦！真厉害！！！

1016373263

Private Sub CommandButton1_Click()
    Dim d As Object, arr, ar
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("c4:e" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(arr)
        If arr(i, 2) <> "是" Then
            If Not d.exists(arr(i, 1)) Then
                d(arr(i, 1)) = Array(arr(i, 3))
            Else
                ar = d(arr(i, 1))
                ReDim Preserve ar(0 To UBound(ar) + 1)
                ar(UBound(ar)) = arr(i, 3)
                d(arr(i, 1)) = ar
            End If
        End If
    Next
    For i = 0 To d.Count - 1
        arr1 = d(d.keys()(i))
        ReDim arr2(0 To UBound(arr1))
        For k = 1 To UBound(arr1) + 1
            arr2(k - 1) = Application.Large(arr1, k)
        Next
        For j = 0 To UBound(arr2)
            n = n + 1
            If Sheet1.Cells(n + 3, 4) <> "是" Then
                Sheet1.Cells(n + 3, 6) = Application.Match(Val(Sheet1.Cells(n + 3, 5).Value), arr2, 0)
            Else
                n = n + 1
                Sheet1.Cells(n + 3, 6) = Application.Match(Val(Sheet1.Cells(n + 3, 5).Value), arr2, 0)
            End If
        Next
    Next
End Sub

1016373263

不用sort排序，用match函数

qlmgu

蓝桥玄霜 发表于 2021-1-23 15:03
排名的例子：

蓝桥玄霜版主您好。您的这个程序对排名需求很有帮助，很实用。我能否请问一下：如果需要一个逆向排名，就是把最低分的设为1,应该如何修改程序呢？谢谢您。

qlmgu

1016373263 发表于 2021-1-23 16:29
不用sort排序，用match函数

1016373263老师您好。您的这个程序对排名需求很有帮助，很实用。我能否请问一下：如果需要一个逆向排名，就是把最低分的设为1,应该如何修改程序呢？谢谢您。

1016373263

qlmgu 发表于 2021-1-23 17:03
1016373263老师您好。您的这个程序对排名需求很有帮助，很实用。我能否请问一下：如果需要一个逆向排名， ...

有点难以读懂，但确实快

1016373263

qlmgu 发表于 2021-1-23 17:03
1016373263老师您好。您的这个程序对排名需求很有帮助，很实用。我能否请问一下：如果需要一个逆向排名， ...

只需要把数组按从小到大排列即可

1016373263

1016373263 发表于 2021-1-23 17:21
只需要把数组按从小到大排列即可

把我的代码中的application.large换成application.small