VBAでDictionary（連想配列）を辞書順にソートする

ハッシュ、連想配列、Dictionaryと呼ばれているデータ構造はたいへん便利であらゆる場面で活用されます。
そうしたデータ構造を、キーの辞書順に処理したいなどという欲求がある場合があるというのは自然なことでしょう。

たとえば、Perlなどの言語のハッシュは一覧した際に、順序は保証されていませんが、ソートする方法が知られています。

sample

my %studentID = (Tom => 10, Mike => 3, Mami => 9);
for my $studentID (sort keys %studentID) {
  print "$name:$studentID{$name}\n";
}

しかし、Excelに順序立てて出力したい場合など、ソートを必要とする場面の多いVBAのDictionaryではソートする方法はないようです。
困りました。そこで、VBAではDictionary（連想配列）をForEachなどで順番に処理すると、入力した順序に処理されることが経験的に知られていることを利用して、一度配列に出力してこれをソートする方法を書いてみました。

※ webで調べると、配列のソートをバブルソートでやっているページが多かったのでクイックソートを実装してみましたが、実装したあとによくよく調べるとRangeオブジェクトのソートがたいへん便利なようなので実用する場合はこちらを使うとよいでしょう
並べ替え（ソート）をマスターしよう！ Excel大辞典

sample

'' テストメソッド
Sub testDicSort()
    Dim output As String
    Dim dic As Object
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic("g") = "gggg"
    dic("9") = "999"
    dic("を") = "をををを"
    dic("4") = "444"
    dic("あ") = "ああああ"
    dic("(") = "(((("
    dic("a") = "aaaa"
    
    output = "##before" & vbNewLine
    
    For Each Key In dic
        output = output & Key & ":" & dic(Key) & vbNewLine
    Next Key
    
    Call DicSort(dic)
    
    output = output + "##after" & vbNewLine
    For Each Key In dic
        output = output & Key & ":" & dic(Key) & vbNewLine
    Next Key
    
    MsgBox output
End Sub


'' Dictionaryを参照引数にし、これをソートする破壊的プロシージャ。
Sub DicSort(ByRef dic As Object)
  Dim i As Long, j As Long, dicSize As Long
  Dim varTmp() As String
  
  dicSize = dic.Count
  
  ReDim varTmp(dicSize + 1, 2)
  
  ' Dictionaryが空か、サイズが1以下であればソート不要
  If dic Is Nothing Or dicSize < 2 Then
    Exit Sub
  End If
  
  ' Dictionaryから二元配列に転写
  i = 0
  For Each Key In dic
    varTmp(i, 0) = Key
    varTmp(i, 1) = dic(Key)
    i = i + 1
  Next
  
  'クイックソート
  Call QuickSort(varTmp, 0, dicSize - 1)
  
  dic.RemoveAll
  
  For i = 0 To dicSize - 1
    dic(varTmp(i, 0)) = varTmp(i, 1)
  Next
End Sub


'' String型で2列の二次元配列を受け取り、これの1列目でクイックソートする（ほんとはCompareメソッドを渡すAdapterパターンで書きたいところ、VBAのオブジェクト指向厳しい感じで妥協）
Private Sub QuickSort(ByRef targetVar() As String, ByVal min As Long, ByVal max As Long)
    Dim i, j As Long
    Dim tmp As String
    
    If min < max Then
        i = min
        j = max
        pivot = strMed3(targetVar(i, 0), targetVar(Int((i + j) / 2), 0), targetVar(j, 0))
        Do
            Do While StrComp(targetVar(i, 0), pivot) < 0
                i = i + 1
            Loop
            Do While StrComp(pivot, targetVar(j, 0)) < 0
                j = j - 1
            Loop
            If i >= j Then Exit Do
                        
            tmp = targetVar(i, 0)
            targetVar(i, 0) = targetVar(j, 0)
            targetVar(j, 0) = tmp
        
            tmp = targetVar(i, 1)
            targetVar(i, 1) = targetVar(j, 1)
            targetVar(j, 1) = tmp
        
            i = i + 1
            j = j - 1
        
        Loop
        Call QuickSort(targetVar, min, i - 1)
        Call QuickSort(targetVar, j + 1, max)
        
    End If
End Sub


'' String型のx, y, z を辞書順比較し二番目のものを返す
Private Function strMed3(ByVal x As String, ByVal y As String, ByVal z As String)
    If StrComp(x, y) < 0 Then
        If StrComp(y, z) < 0 Then
            strMed3 = y
        ElseIf StrComp(z, x) < 0 Then
            strMed3 = x
        Else
            strMed3 = z
        End If
    Else
        If StrComp(z, y) < 0 Then
            strMed3 = y
        ElseIf StrComp(x, z) < 0 Then
            strMed3 = x
        Else
            strMed3 = z
        End If
    End If
End Function

雑感

• QiitaでVBAコードをシンタックスハイライトさせる場合はvbと記述するとよい（2018.2.20まではvb.netだった）
• VBAをオブジェクト指向に書くには、インタフェースを使って多態性ある感じにしたいけれどあまりうまく使えない（自分の調査不足もある）