Excel VBA：输入key和value两个单元格区域，以value的值比较排序，然后返回key的排序

Posted 2023-02-18 Limpie

代码部分：

Option Explicit
Sub example()
Dim key As Range
Dim value As Range
Dim updown As Integer, rankNum As Integer
Set key = Sheet1.Range("A2:A8")
Set value = Sheet1.Range("B2:B8")
updown = 0
rankNum = 3
MsgBox sortRange(key, value, updown, rankNum)
End Sub

Function sortRange(key As Range, value As Range, updown As Integer, rankNum As Integer)
'函数功能：输入key和value两个单元格区域，以value的值比较排序，然后返回key的排序。
'代码逻辑：用rank()公式函数把value区域的值排名、存值，然后取出排名靠前的多少个key值。
'key：排序后显示的名称区域
'value：用于排序比较的数值区域
'updown：0为降序排，非0为升序排
'rankNum：只要求排名的前多少位
Dim longArr As Integer
Dim i, j As Integer
Dim out As String
If key.Columns.Count = 1 And value.Columns.Count = 1 Then
    If key.Rows.Count = value.Rows.Count Then
        longArr = key.Rows.Count
        ReDim order(1 To longArr) As Integer
        For i = 1 To longArr '排名、存值
             order(i) = Application.WorksheetFunction.Rank(value(i), value, updown) '任何时候不能用省略写法，坑。
        Next i
        For j = 1 To rankNum '取出排名靠前的key值
            For i = 1 To longArr
                If order(i) = j Then
                    If out = "" Then
                        out = key(i)
                    Else
                        out = out & "、" & key(i)
                    End If
                End If
            Next i
        Next j
        sortRange = out
    Else
        MsgBox "错误：两区域长度不等。"
        End
    End If
Else
    MsgBox "错误：其中一区域包含两列及以上。"
    End
End If
End Function

Excel的示例数据：

结果：