Question

我有一个带整数键和整数项的字典，只需要根据键对字典进行排序，但我发现的所有例子都只适用于字符串键。

Answer 1

将键作为数组抓取，对该数组进行排序，然后使用已排序的数组从字典中提取值。

Sub Tester()

    Dim d As Object
    Dim i As Long, arr, k

    Set d = CreateObject("scripting.dictionary")


    With d
        .Add 3, 33
        .Add 1, 33
        .Add 2, 55
        .Add 5, 77
    End With

    arr = d.keys  '<< get keys in an array

    ' "sort" through the array, and get the values from the dictionary
    Debug.Print "key", "value"
    For i = 0 To UBound(arr)
        k = Application.Small(arr, i + 1)
        Debug.Print k, d(k)
    Next i

End Sub

输出：

  key          value
  1             33   
  2             55   
  3             33   
  5             77

Answer 2

这是一个基于使用.Net容器ArrayList的解决方案 - 可以在VBA中使用。排序需要花费很多麻烦：

Function DictToSortedArray(D As Object) As Variant
    'returns a 1-based 2-dimensional sorted array
    'sorted by the keys
    Dim A As Variant, i As Long, AL As Object, k As Variant

    Set AL = CreateObject("System.Collections.ArrayList")

    For Each k In D
        AL.Add k
    Next k

    AL.Sort

    ReDim A(1 To AL.Count, 1 To 2)

    For i = 1 To AL.Count
        A(i, 1) = AL(i - 1)
        A(i, 2) = D(AL(i - 1))
    Next i

    DictToSortedArray = A
End Function

一个简单的测试：

Sub test()
    Dim D As Object
    Dim A As Variant
    Dim i As Long

    Set D = CreateObject("Scripting.Dictionary")
    D.Add 5, 8
    D.Add 3, 7
    D.Add 42, 9
    D.Add 1, 7
    D.Add 10, 11

    A = DictToSortedArray(D)
    For i = 1 To 5
        Debug.Print A(i, 1) & ", " & A(i, 2)
    Next i
End Sub

输出：

Answer 3

编辑以添加输出X和Y数组的解决方案

您可以使用SortedList对象并构建一个辅助子类，如下所示：

Sub SortDictionary(dict As Object)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        dict.RemoveAll
        For i = 0 To .Keys.Count - 1
            dict.Add .GetKey(i), .Item(.GetKey(i))
        Next
    End With
End Sub

被利用如下：

SortDictionary dict '<--| give 'SortDictionary()' sub a dictionary object to sort by its keys

例如，这是一个测试：

Sub main()

    Dim dict As Object
    Dim key As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add 5, 15
        .Add 4, 14
        .Add 3, 13
        .Add 2, 12
        .Add 1, 11
    End With

    SortDictionary dict

    With dict
        For Each key In .Keys
            Debug.Print key, .Item(key)
        Next
    End With
End Sub

以上内容可以很容易地将X和Y数组从字典keys和items中删除，如下所示：

Sub SortDictionaryToArray(dict As Object, XArray As Variant, YArray As Variant)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        ReDim XArray(0 To .Count)
        ReDim YArray(0 To .Count)
        For i = 0 To .Keys.Count - 1
            XArray(i) = .GetKey(i)
            YArray(i) = .Item(.GetKey(i))
        Next
    End With
End Sub

将在您的主要子资源中被利用，如下所示：

SortDictionaryToArray dict, Xs, Ys

正如您在此完整测试中所看到的那样：

Sub main()

    Dim dict As Object
    Dim i As Long
    Dim Xs As Variant, Ys As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add 5, 15
        .Add 4, 14
        .Add 3, 13
        .Add 2, 12
        .Add 1, 11
    End With

    SortDictionaryToArray dict, Xs, Ys

    For i = 0 To UBound(Xs)
        Debug.Print Xs(i), Ys(i)
    Next
End Sub

Answer 4

将密钥和项目放入字典中，覆盖项目以维护唯一密钥
将密钥复制到1-D阵列
对1-D数组进行排序
将其中一个临时变体重用为二维数组
将排序后的“密钥”放入二维数组，并使用“密钥”将相关项目从原始字典调用到第二级。

代码：

Option Explicit

Sub sortedDictionary()
    Dim i As Long, j As Long, d As Long, dict As Object
    Dim vKEYs As Variant, tmp As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet4")
        For d = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            dict.Item(.Cells(d, "A").Value2) = .Cells(d, "B").Value2
        Next d

        vKEYs = dict.keys

        For i = LBound(vKEYs) + 1 To UBound(vKEYs)
            For j = LBound(vKEYs) To UBound(vKEYs) - 1
                If vKEYs(j) > vKEYs(i) Then
                    tmp = vKEYs(j)
                    vKEYs(j) = vKEYs(i)
                    vKEYs(i) = tmp
                End If
            Next j
        Next i

        ReDim tmp(1 To UBound(vKEYs) + 1, 1 To 2)

        For i = LBound(vKEYs) To UBound(vKEYs)
            tmp(i + 1, 1) = vKEYs(i)
            tmp(i + 1, 2) = dict.Item(vKEYs(i))
        Next i

        .Cells(2, "E").Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
    End With
End Sub

结果：

按数字键排序字典

4 个答案: