VBA Collection ソート

http://homepage1.nifty.com/rucio/main/dotnet/shokyu/standard28.htm
にバブルソートを使った方法が載っている。
クラス2つと、ソート関数を使ったもの。
上記のURLだとクラスの変数を渡しており、
かつStringの比較なので
integerで比較してソートをすると、うまくいかないので
こんな感じに変更してソートできた。
関数単体で使用可能

Sub sortCollection(ByRef p_col As Collection)
Dim l_colRet    As Collection
Dim l_cls       As Object
Dim l_clsMin    As Object
Dim l_intMinID As Integer
Dim i           As Integer
Set l_colRet = New Collection
Do Until (p_col.count = 0)
'まずは先頭を基準
l_intMinID = 1
'先頭ははずしてループ
For i = 2 To p_col.count
'Intgerに変換して比較
If CInt(p_col(l_intMinID)) > (p_col(i)) Then
'i番目の方が小さければ、それが基準
l_intMinID = i
End If
Next i
'一番小さい基準値のデータを登録
l_colRet.Add p_col(l_intMinID)
'引数のデータから削除
p_col.Remove l_intMinID
Loop
'結果の返却
Set p_col = l_colRet
End Sub

ソートの降順、昇順も切り替えをできるようにさらに追加すると
こんな感じか。

'collectionのソート
'sortType:昇順ならASC、降順なら、DESCを指定
Sub sortCollection(ByRef p_col As Collection, sortType As String)
Dim l_colRet    As Collection
Dim l_cls       As Object
Dim l_clsMin    As Object
Dim l_intMinID As Integer
Dim i           As Integer
Set l_colRet = New Collection
Do Until (p_col.count = 0)
'まずは先頭を基準
l_intMinID = 1
'先頭ははずしてループ
For i = 2 To p_col.count
If sortType = "ASC" Then
'Intgerに変換して比較
If CInt(p_col(l_intMinID)) > (p_col(i)) Then
'i番目の方が小さければ、それが基準
l_intMinID = i
End If
ElseIf sortType = "DESC" Then
If CInt(p_col(l_intMinID)) < (p_col(i)) Then
l_intMinID = i
End If
End If
Next i
'一番小さい基準値のデータを登録
l_colRet.Add p_col(l_intMinID)
'引数のデータから削除
p_col.Remove l_intMinID
Loop
'結果の返却
Set p_col = l_colRet
End Sub
タイトルとURLをコピーしました