DuKiccoの雑記

My Life Is Myself

【配列内の順位を取得する/ソートする。】【エクセル,VBA】

VBAでは配列内の数値の順位を取得したり、並べ替えたりといった関数が存在しませんので自作してみました。

Worksheet.FunctionのLARGE関数やSMALL関数を使用するとシンプルなコードで実現できます。ちなみに順位の取得にはRANK関数が使用できるともっともシンプルなのですがこちらの関数は配列を引数にできないために使えません。LARGE関数は降順、SMALL関数は昇順の順番を出すために使用します。

Function Rank関数降順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。降順。
Dim i As Long

For i = 1 To UBound(arr)
    '降順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Large(arr, i) Then
        Rank関数降順 = i
        Exit For
    End If
Next

End Function
Function Rank関数昇順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。昇順。
Dim i As Long

For i = 1 To UBound(arr)
    '昇順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Small(arr, i) Then
        Rank関数昇順 = i
        Exit For
    End If
Next

End Function
Function ソート降順(arr As Variant) As Variant()
'arrはソートしたい配列。
Dim i As Long, arr1() As Variant

ReDim arr1(1 To UBound(arr)) As Variant

For i = 1 To UBound(arr)
 '昇順1位から順にループしていき配列を格納していく。
    arr1(i) = WorksheetFunction.Large(arr, i)
    
Next

ソート降順 = arr1

End Function

Sub test1()
'動作確認
Dim arr(1 To 5) As Variant, arr1 As Variant, i As Long

arr(1) = 10
arr(2) = 2
arr(3) = 100
arr(4) = 11
arr(5) = 20

'Rankの結果確認
MsgBox Rank関数降順(arr, 1)
MsgBox Rank関数昇順(arr, 2)

'ソート降順の結果確認
arr1 = ソート降順(arr)

For i = 1 To 5
    Debug.Print arr1(i)
Next
End Sub