【VBA】辞書（Dictionary）を並び替える方法（keyをソート　昇順降順対応）｜もしも普通のサラリーマンがお金とITを学んだら

このページでわかること

DictionaryのKeyを昇順に並び替えることができます。
DictionaryのKeyを配列に移し替えて、
マージソート（アルゴリズム）を活用して、配列内ソートをかけます。
並び替えた配列を辞書に入れなおします。
もちろん値もkeyに連動して並び替えています。

こんにちは、hokkyokunです。

以前のブログで配列内の並び替え（ソート）を
マージソートというアルゴリズムを活用して、関数化しました。
詳しくはこちらをご覧ください。

今回は辞書(Dictionary)をソートします。

辞書は重複のないユニークなリストをお手軽に作ることができます。
事務系でVBAを使う方は真っ先に覚えて損はないです！！

そんな辞書ですが、配列同様ソートがないという
残念な仕様になっています。

今回は、配列内ソートを応用して、
辞書のKeyを昇順に変更してみたいと思います。
もちろん、Keyの順番に連動して値も順番が変わります。

では行ってみましょう！！！

Contents

準備：乱数を使用して、ランダムな値を辞書に格納
辞書(Key)を昇順にソートする関数（コピペ可！）
エクセル上で処理すれば楽？

準備：乱数を使用して、ランダムな値を辞書に格納

まず、準備として、
辞書にランダムな数値を格納してみます。

乱数を生成するプログラムを以前、関数化しているので、
よかったら、見てください。

尚、辞書はKeyに同じ値を格納できないので、
乱数は重複のないユニークになるような乱数生成プログラムを使用しています。

Sub test()
    Dim arr As Variant '配列をfor eachで回す用の変数
    Dim arrs_Rnd() As Variant '生成した乱数を格納する配列
    Dim dicts As New Dictionary '辞書を変数宣言＋インスタンス化
    Dim l As Variant '辞書をfor eachで回す用の変数
    Dim i As Long 'forで回す用のインデックス
    
    'ユニークな乱数を発生させる関数（詳しくはブログ見てね！）
    arrs_Rnd = get_unique_Random(10, 1, 100)
    
    '生成した乱数を辞書に登録
    '乱数をkey、乱数×10を値に格納
    For Each arr In arrs_Rnd
        dicts.Add arr, arr * 10
    Next
    
    '辞書に登録できたか、シートに転記して確認
    i = 2
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 1).Value = "ソート前:key"
        .Cells(1, 2).Value = "ソート前:value"
        For Each l In dicts
            .Cells(i, 1).Value = l
            .Cells(i, 2).Value = dicts.Item(l)
            i = i + 1
        Next
    End With
End Sub

下記のように乱数を生成しました。

辞書(Key)を昇順にソートする関数（コピペ可！）

上記のように、登録した辞書を
昇順に並べ替えします。

関数を作成しました。コピペで使用できます！！

※使用上の注意

この関数は辞書を配列に格納しなおし、
配列をマージソートというアルゴリズムで並び替えしています。
マージソートはかなり複雑なプログラムを使用していますので、
別で関数化しています。
詳しくはこちらをご覧ください。このページから関数をコピペできます。
Dictionaryオブジェクトを使うにはVBE上で参照設定を行う必要があります。
詳しくは「VBA dictionary 参照設定」で検索してみてください。

コード

冒頭でも触れましたが、
並び替え（ソート）はマージソートというアルゴリズムを活用しています。
こちらで解説しています。
配列内ソートも関数化しているので、是非見てみてください。

Function sort_Dictionary(dicts As Variant, asc As Boolean)
    Dim l As Variant '辞書をfor eachで回す用
    Dim arr As Variant '配列をfor eachで回す用
    Dim arrs() As Variant '引数の辞書を配列に格納する
    Dim i As Long 'for文で回すインデックス
    Dim new_Dicts As New Dictionary 'ソート後の辞書を格納する
    
    '引数の辞書のkeyを配列に格納
    For Each l In dicts
        ReDim Preserve arrs(i)
        arrs(i) = l
        i = i + 1
    Next
    
    '配列をマージソートを使って昇順に並び替え
    'こちらもブログで解説しているので見てください！！
    arrs =merge_Sort_for_Int(arrs, asc)
    
    'new_dictsに並び替え後の配列を登録
    For Each arr In arrs
        new_Dicts.Add arr, dicts.Item(arr)
    Next
    Set sort_Dictionary = new_Dicts
End Function

使い方

使い方を説明します。

引数は二つあります。
第一引数　：　辞書。Dictionary型
第二引数　：　昇順降順の指定。Boolean型
　　　　　　　昇順　：　True
　　　　　　　降順　：　False

試しに動かしてみます。

上記のSubプロシージャ「Test」と同様に
乱数を生成し、辞書に格納させます。
その後、sort_Dictionaryを動かし、並び替えがうまくいったか、
シートに転記しています。

Sub test2()
    Dim arr As Variant '配列をfor eachで回す用の変数
    Dim arrs_Rnd() As Variant '生成した乱数を格納する配列
    Dim dicts As New Dictionary '辞書を変数宣言＋インスタンス化
    Dim l As Variant '辞書をfor eachで回す用の変数
    Dim i As Long 'forで回す用のインデックス
    
    'ユニークな乱数を発生させる関数（詳しくはブログ見てね！）
    arrs_Rnd = get_unique_Random(10, 1, 100)
    
    '生成した乱数を辞書に登録
    '乱数をkey、乱数×10を値に格納
    For Each arr In arrs_Rnd
        dicts.Add arr, arr * 10
    Next
    
    '辞書に登録できたか、シートに転記して確認
    i = 2
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 1).Value = "ソート前:key"
        .Cells(1, 2).Value = "ソート前:value"
        For Each l In dicts
            .Cells(i, 1).Value = l
            .Cells(i, 2).Value = dicts.Item(l)
            i = i + 1
        Next
    End With
    
'================================================================================
'========ここより上はサブプロシージャtestと同じ==================================
'================================================================================
    
    Dim new_Dicts As New Dictionary 'ソート後の辞書
    Set new_Dicts = sort_Dictionary(dicts, asc:=True)
    
    'ソート後の辞書の中身をシートに転記
    i = 2
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 4).Value = "ソート後:key"
        .Cells(1, 5).Value = "ソート後:value"
        For Each l In new_Dicts
            .Cells(i, 4).Value = l
            .Cells(i, 5).Value = new_Dicts.Item(l)
            i = i + 1
        Next
    End With
End Sub

こんな感じで処理されると思います。

辞書に日付を格納して昇順に並び替えする

次は日付を辞書に格納して、並び替えをしてみます。

Sub test3()
    Dim arr As Variant '配列をfor eachで回す用の変数
    Dim arrs_Rnd() As Variant '生成した乱数を格納する配列
    Dim dicts As New Dictionary '辞書を変数宣言＋インスタンス化
    Dim l As Variant '辞書をfor eachで回す用の変数
    Dim i As Long 'forで回す用のインデックス
    
    ThisWorkbook.Worksheets(1).Cells.ClearContents
    
    'ユニークな乱数を発生させる関数（詳しくはブログ見てね！）
    arrs_Rnd = get_unique_Random_date(10, #5/1/2022#, #6/30/2022#)
    
    '生成した乱数を辞書に登録
    '乱数をkey、乱数＋10日を値に格納
    For Each arr In arrs_Rnd
        dicts.Add arr, DateAdd("d", 10, arr)
    Next
    
    '辞書に登録できたか、シートに転記して確認
    i = 2
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 1).Value = "ソート前:key"
        .Cells(1, 2).Value = "ソート前:value"
        For Each l In dicts
            .Cells(i, 1).Value = l
            .Cells(i, 2).Value = dicts.Item(l)
            i = i + 1
        Next
    End With
    
'================================================================================
'========ここより上はサブプロシージャtestと基本は同じ============================
'================================================================================
    
    Dim new_Dicts As New Dictionary 'ソート後の辞書
    Set new_Dicts = sort_Dictionary(dicts, asc:=True)
    
    'ソート後の辞書の中身をシートに転記
    i = 2
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 4).Value = "ソート後:key"
        .Cells(1, 5).Value = "ソート後:value"
        For Each l In new_Dicts
            .Cells(i, 4).Value = l
            .Cells(i, 5).Value = new_Dicts.Item(l)
            i = i + 1
        Next
    End With
End Sub

こんな感じです。