我有一个带整数键和整数项的字典,只需要根据键对字典进行排序,但我发现的所有例子都只适用于字符串键。
答案 0 :(得分:6)
将键作为数组抓取,对该数组进行排序,然后使用已排序的数组从字典中提取值。
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
答案 1 :(得分:4)
这是一个基于使用.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
答案 2 :(得分:2)
编辑以添加输出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
答案 3 :(得分:1)
代码:
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
结果: