如何对一行数据进行中国式排名？

逆天修炼

如题，请教路过的大神，采用VBA编码的方式对第一行数据进行中国式排名，结果写在第三行里，谢谢！

liulang0808

Sub 按钮1_Click()
    arr = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To UBound(arr, 2)
        d(Val(arr(2, j))) = arr(2, j)
    Next j
    For j = 1 To d.Count
        k = WorksheetFunction.Large(d.keys, j)
        d(k) = j
    Next j
    For j = 2 To UBound(arr, 2)
        arr(3, j) = d(Val(arr(2, j)))
    Next j
    [a1].CurrentRegion = arr
End Sub

liulang0808

供参考。。。。。

swl4561255

1. Sub test()
   
2. arr = Range("A1").CurrentRegion
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For i = 2 To UBound(arr, 2)
   
5.     d(arr(2, i)) = ""
   
6. Next
   
7. k = d.keys
   
8. For j = 2 To UBound(arr, 2)
   
9.    n = 0
   
10.    For Each r In k
    
11.         If r > arr(2, j) Then
    
12.             n = n + 1
    
13.         End If
    
14.     Next
    
15.     arr(3, j) = n + 1
    
16. Next
    
17. [A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
18. End Sub

复制代码

Qs18

Public Sub test()
Dim arr, MyArray, dic As Object
Set dic = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
With Sheet1
    arr = .Range("a1").CurrentRegion.Value
    '先去重
    For i = 2 To UBound(arr, 2)
        dic(arr(2, i)) = ""
    Next i
MyArray = dic.keys
    ' 获取数组的长度排序
n = UBound(MyArray)
    For i = LBound(MyArray) To n
        For j = LBound(MyArray) To n - i - 1
            If MyArray(j) < MyArray(j + 1) Then
                ' 交换元素
                Temp = MyArray(j)
                MyArray(j) = MyArray(j + 1)
                MyArray(j + 1) = Temp
            End If
        Next j
    Next i
    For i = LBound(MyArray) To UBound(MyArray)
    dic2(MyArray(i)) = i + 1
    Next
For i = 2 To UBound(arr, 2)
arr(3, i) = dic2(arr(2, i))
Next
.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
End With
End Sub

逆天修炼

liulang0808 发表于 2024-5-10 13:35
Sub 按钮1_Click()
    arr = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")

请问liulang0808老师，如何我还要知道第1名有几人？第2名有几人？。。。又如何调整代码呢？

liulang0808

逆天修炼 发表于 2024-5-10 15:26
请问liulang0808老师，如何我还要知道第1名有几人？第2名有几人？。。。又如何调整代码呢？

如果针对表格内容，可以使用公式countif，代码中可以再使用字典计数统计

一招秒杀

数据库 2001年开始支持 Rank ，Dernse_Rank  各种分组排名窗口函数，简单到只要一个函数，让你的精力聚焦到业务逻辑，而不是数据处理细节。
几十年后的今天，还要为了这么简单的功能来写一大堆代码，感觉很原始，太麻烦，易出错，没效率，不划算。

micch

1. =11-COUNT(MATCH(SEQUENCE(B2),2:2,))

复制代码