2011年2月15日火曜日

Scripting.Dictionaryオブジェクトのソート

あまり必要ありませんが、何かに使えるかもしれないのでメモ。

バリアント配列の初期化に誤りがあったので修正

Private Sub DicSort(ByRef dic As Scripting.Dictionary)
  Dim i As Long, j As Long
  Dim d As Variant
  Dim varTemp As Variant
  Dim varData() As Variant
  
  If dic Is Nothing And dic.Count = 0 Then
    Exit Sub
  End If
  
  'バリアント二次元配列
  ReDim varData(dic.Count - 1 , 1)
  i = 0
  For Each d In dic
    varData(i, 0) = d
    varData(i, 1) = dic(d)
    i = i + 1
  Next
  
  '総当りでソート(バブルソート)
  For i = 0 To dic.Count - 1
    For j = i + 1 To dic.Count - 1
      '比較
      If varData(i, 0) > varData(j, 0) Then
        '次の配列の値が小さい場合は入替
        varTemp = Array(varData(i, 0), varData(i, 1))
        varData(i, 0) = varData(j, 0)
        varData(i, 1) = varData(j, 1)
        varData(j, 0) = varTemp(0)
        varData(j, 1) = varTemp(1)
      End If
    Next
  Next
  
  dic.RemoveAll
  
  For i = 0 To UBound(varData)
    dic(varData(i, 0)) = varData(i, 1)
  Next
End Sub

エラーチェックはしていません。

0 件のコメント:

コメントを投稿