Edited at

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をオブジェクト指向に書くには、インタフェースを使って多態性ある感じにしたいけれどあまりうまく使えない(自分の調査不足もある)