按数字键sorting字典

我有一个整数键和整数项的字典，只需要基于键sorting字典，但我发现所有的例子只适用于string键。

Answer 1

编辑以添加一个解决scheme来输出X和Y数组

你可以使用SortedList对象，像下面这样构build一个helper子类：

 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 

例如这里是一个testing：

 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 

---

上面的东西可以很容易的被Twicked从字典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 

正如你在这个完整的testing中看到的那样：

 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 2

以数组forms获取键，对该数组进行sorting，然后使用sorting后的数组从字典中提取值。

 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 3

这是一个基于使用.Net容器ArrayList的解决scheme – 可以在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 

一个简单的testing：

 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 

Answer 4

• 把钥匙和物品放到字典中，覆盖物品以保持唯一的钥匙
• 将密钥复制到一维数组中
• 对一维数组进行sorting
• 重用其中一个临时变体作为二维数组
• 把sorting的“键”放入二维数组中，并使用“键”将原始字典中的相关项目调用到第二个sorting。

码：

 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 

结果：