オブジェクトのコレクションに対して、指定されたプロパティで昇順ソートを行う。この場合に固有なのは、最初にキーだけ集めてからソートしている点くらいだけど、これだけでも、1 時間かかってたのが数秒になったりした。所詮バブルソートなので、2000 件の String 型プロパティで 6 秒とかかかるけど。
型がわかっていれば、キーを格納するローカル変数 (Keys と KeyTmp) の型をそれにすればよいが、String と Date で試した限りでは、若干高速化する程度のようだ。
Public Sub SortObjectCollection(ByVal Items As Collection, ByVal Prop As String) Dim Objects() As Object 'ソート前の内容を保存する Dim Keys() As Variant 'プロパティ値のリスト Dim Indeces() As Long 'ソート前の位置のリスト Dim KeyTmp As Variant 'プロパティ値(スワップ用) Dim IndexTmp As Long 'ソート前の位置(スワップ用) Dim Count As Integer '要素数 Dim I As Integer Dim J As Integer Count = Items.Count ReDim Objects(1 To Count) ReDim Keys(1 To Count) ReDim Indeces(1 To Count) For I = 1 To Count Set Objects(I) = Items(I) Keys(I) = CallByName(Objects(I), Prop, VbGet) Indeces(I) = I Next For I = Count To 2 Step -1 For J = 2 To I If Keys(J) < Keys(J - 1) Then KeyTmp = Keys(J) IndexTmp = Indeces(J) Keys(J) = Keys(J - 1) Indeces(J) = Indeces(J - 1) Keys(J - 1) = KeyTmp Indeces(J - 1) = IndexTmp End If Next Next '全要素を一旦削除 For I = Count To 1 Step -1 Items.Remove I Next 'ソート後の順番で入れ直す For I = 1 To Count Items.Add Objects(Indeces(I)) Next End Sub