我有一个包含整数键和整数项的字典，只需要根据键对字典进行排序，但我发现的所有示例都只适用于字符串键。
【问题讨论】：
标签： arrays vba excel dictionary
编辑添加了输出 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
上面的内容可以很容易地从字典keys和items中返回X和Y数组，如下所示：
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
【讨论】：
代码：
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
结果：
【讨论】：
这是一个基于使用 .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
输出：
1, 7
3, 7
5, 8
10, 11
42, 9
【讨论】：
将键作为数组获取，对该数组进行排序，然后使用排序后的数组从字典中提取值。
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
【讨论】：