VBA(配列ソート)

 

連想配列を値でソートしてキーを動的配列として返す

 

-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する

-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行

※ 下記設定必要
「Microsoft Scripting Runtime」の参照設定

Option Explicit

Private Sub CommandButton1_Click()

    
    '画面を更新しない
    Application.ScreenUpdating = False
    '確認メッセージを表示しない
    Application.DisplayAlerts = False
    
    
    Dim myDic As New Dictionary
    Set myDic = Nothing
    
    Dim i As Long
    
    For i = 1 To 5
        myDic.Add i, CStr(Int(100 * Rnd))
    Next i
    
    Dim myArr() As String
    Erase myArr
    
    Dim vkey As Variant

    For Each vkey In myDic
        Debug.Print "before myDic", vkey, myDic(vkey)
    Next
    

    
    
    '連想配列をソートして動的配列に格納。入力連想配列はゼロに破壊される
    Call SortDic(myDic, myArr())

    For Each vkey In myDic
        Debug.Print "after myDic", vkey, myDic(vkey)
    Next
        
    For i = LBound(myArr, 1) To UBound(myArr, 1)
        Debug.Print "after myArr", myArr(i)
    Next i
    
    
    
    '確認メッセージを表示する
    Application.DisplayAlerts = True
    '画面を更新する
    Application.ScreenUpdating = True

 

End Sub

'連想配列ソート
'連想配列はByValと指定してもByRefの挙動となる模様
Sub SortDic(ByRef sDic As Dictionary, ByRef dArr() As String)

    Dim minkey As Variant
    Dim minval As Long
    
    Dim i As Long
    
    i = 0

    Do While sDic.Count > 0
    
        minval = 2147483647
        Dim vkey As Variant
        
        For Each vkey In sDic
    
            If minval > CLng(sDic(vkey)) Then
                minval = sDic(vkey)
                minkey = vkey
            End If
        Next vkey
        
        ReDim Preserve dArr(i)
        dArr(i) = minkey
        i = i + 1
        sDic.Remove minkey
        
        
    Loop

End Sub