VB6.0 Dictionary排序

Option Explicit


Private Sub Form_Load()
    
    Dim dict As Scripting.Dictionary
    Dim item
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    dict.Add "aaa", 1
    dict.Add "ccc", 7
    dict.Add "bbb", 5
    
    SortDictionary dict, 1 '排序
    
    For Each item In dict
        Text1.Text = Text1.Text & item & "," & dict(item) & vbCrLf
    Next
End Sub

'说明：Dictionary排序
'参数：
'   objDict:Dictionary对象
'   intSort: 1 根据key排序; 2 根据value排序
Function SortDictionary(objDict, intSort)
  ' declare our variables
  Dim strDict()
  Dim objKey
  Dim strKey, strItem
  Dim X, Y, Z

  ' get the dictionary count
  Z = objDict.Count

  ' we need more than one item to warrant sorting
  If Z > 1 Then
    ' create an array to store dictionary information
    ReDim strDict(Z, 2)
    X = 0
    ' populate the string array
    For Each objKey In objDict
        strDict(X, 1) = CStr(objKey)
        strDict(X, 2) = CStr(objDict(objKey))
        X = X + 1
    Next

    ' perform a a shell sort of the string array
    For X = 0 To (Z - 2)
      For Y = X To (Z - 1)
        If StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare) > 0 Then
            strKey = strDict(X, 1)
            strItem = strDict(X, 2)
            strDict(X, 1) = strDict(Y, 1)
            strDict(X, 2) = strDict(Y, 2)
            strDict(Y, 1) = strKey
            strDict(Y, 2) = strItem
        End If
      Next
    Next

    ' erase the contents of the dictionary object
    objDict.RemoveAll

    ' repopulate the dictionary with the sorted information
    For X = 0 To (Z - 1)
      objDict.Add strDict(X, 1), strDict(X, 2)
    Next

  End If

End Function