我有一组我想要从最小到最大排序的数字键。
Dim result
Set result = CreateObject("Scripting.Dictionary")
For i = 1 To N
weeksThisIteration = 0
Do While conditiaonTrue
//...
weeksThisIteration = weeksThisIteration + 1
Loop
'If Not result.Item(weeksThisIteration) Then
' result.Add weeksThisIteration, 0//apparently I don't have to initiailize
'End If
result.Item(weeksThisIteration) = result.Item(weeksThisIteration) + 1
我想对result进行排序，最好是在子/函数内。我试过了：
MySort(list As Scripting.Dictionary) 我在传递值方面遇到了问题。我添加了对“Microsoft Scripting Runtime”的引用。当我调用方法时，我仍然遇到关于传递ByRef的错误，而且我不确定实现。
SortDictionary。 VBA表示该功能不存在。 如何在方法中实现数字KEY排序并使用此数据类型调用它？
答案 0 :(得分：1)
看看this page。
具体来说，他有一个名为 SortDictionary：
的部分Public Sub SortDictionary(Dict As Scripting.Dictionary, _
SortByKey As Boolean, _
Optional Descending As Boolean = False, _
Optional CompareMode As VbCompareMethod = vbTextCompare)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SortDictionary
' This sorts a Dictionary object. If SortByKey is False, the
' the sort is done based on the Items of the Dictionary, and
' these items must be simple data types. They may not be
' Object, Arrays, or User-Defined Types. If SortByKey is True,
' the Dictionary is sorted by Key value, and the Items in the
' Dictionary may be Object as well as simple variables.
'
' If sort by key is True, all element of the Dictionary
' must have a non-blank Key value. If Key is vbNullString
' the procedure will terminate.
'
' By defualt, sorting is done in Ascending order. You can
' sort by Descending order by setting the Descending parameter
' to True.
'
' By default, text comparisons are done case-INSENSITIVE (e.g.,
' "a" = "A"). To use case-SENSITIVE comparisons (e.g., "a" <> "A")
' set CompareMode to vbBinaryCompare.
'
' Note: This procedure requires the
' QSortInPlace function, which is described and available for
' download at www.cpearson.com/excel/qsort.htm .
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
Dim KeyValue As String
Dim ItemValue As Variant
Dim Arr() As Variant
Dim KeyArr() As String
Dim VTypes() As VbVarType
Dim V As Variant
Dim SplitArr As Variant
Dim TempDict As Scripting.Dictionary
'''''''''''''''''''''''''''''
' Ensure Dict is not Nothing.
'''''''''''''''''''''''''''''
If Dict Is Nothing Then
Exit Sub
End If
''''''''''''''''''''''''''''
' If the number of elements
' in Dict is 0 or 1, no
' sorting is required.
''''''''''''''''''''''''''''
If (Dict.Count = 0) Or (Dict.Count = 1) Then
Exit Sub
End If
''''''''''''''''''''''''''''
' Create a new TempDict.
''''''''''''''''''''''''''''
Set TempDict = New Scripting.Dictionary
If SortByKey = True Then
''''''''''''''''''''''''''''''''''''''''
' We're sorting by key. Redim the Arr
' to the number of elements in the
' Dict object, and load that array
' with the key names.
''''''''''''''''''''''''''''''''''''''''
ReDim Arr(0 To Dict.Count - 1)
For Ndx = 0 To Dict.Count - 1
Arr(Ndx) = Dict.Keys(Ndx)
Next Ndx
''''''''''''''''''''''''''''''''''''''
' Sort the key names.
''''''''''''''''''''''''''''''''''''''
QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:=CompareMode
''''''''''''''''''''''''''''''''''''''''''''
' Load TempDict. The key value come from
' our sorted array of keys Arr, and the
' Item comes from the original Dict object.
''''''''''''''''''''''''''''''''''''''''''''
For Ndx = 0 To Dict.Count - 1
KeyValue = Arr(Ndx)
TempDict.Add Key:=KeyValue, Item:=Dict.Item(KeyValue)
Next Ndx
'''''''''''''''''''''''''''''''''
' Set the passed in Dict object
' to our TempDict object.
'''''''''''''''''''''''''''''''''
Set Dict = TempDict
''''''''''''''''''''''''''''''''
' This is the end of processing.
''''''''''''''''''''''''''''''''
Else
'''''''''''''''''''''''''''''''''''''''''''''''
' Here, we're sorting by items. The Items must
' be simple data types. They may NOT be Objects,
' arrays, or UserDefineTypes.
' First, ReDim Arr and VTypes to the number
' of elements in the Dict object. Arr will
' hold a string containing
' Item & vbNullChar & Key
' This keeps the association between the
' item and its key.
'''''''''''''''''''''''''''''''''''''''''''''''
ReDim Arr(0 To Dict.Count - 1)
ReDim VTypes(0 To Dict.Count - 1)
For Ndx = 0 To Dict.Count - 1
If (IsObject(Dict.Items(Ndx)) = True) Or _
(IsArray(Dict.Items(Ndx)) = True) Or _
VarType(Dict.Items(Ndx)) = vbUserDefinedType Then
Debug.Print "***** ITEM IN DICTIONARY WAS OBJECT OR ARRAY OR UDT"
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Here, we create a string containing
' Item & vbNullChar & Key
' This preserves the associate between an item and its
' key. Store the VarType of the Item in the VTypes
' array. We'll use these values later to convert
' back to the proper data type for Item.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Arr(Ndx) = Dict.Items(Ndx) & vbNullChar & Dict.Keys(Ndx)
VTypes(Ndx) = VarType(Dict.Items(Ndx))
Next Ndx
''''''''''''''''''''''''''''''''''
' Sort the array that contains the
' items of the Dictionary along
' with their associated keys
''''''''''''''''''''''''''''''''''
QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:=vbTextCompare
For Ndx = LBound(Arr) To UBound(Arr)
'''''''''''''''''''''''''''''''''''''
' Loop trhogh the array of sorted
' Items, Split based on vbNullChar
' to get the Key from the element
' of the array Arr.
SplitArr = Split(Arr(Ndx), vbNullChar)
''''''''''''''''''''''''''''''''''''''''''
' It may have been possible that item in
' the dictionary contains a vbNullChar.
' Therefore, use UBound to get the
' key value, which will necessarily
' be the last item of SplitArr.
' Then Redim Preserve SplitArr
' to UBound - 1 to get rid of the
' Key element, and use Join
' to reassemble to original value
' of the Item.
'''''''''''''''''''''''''''''''''''''''''
KeyValue = SplitArr(UBound(SplitArr))
ReDim Preserve SplitArr(LBound(SplitArr) To UBound(SplitArr) - 1)
ItemValue = Join(SplitArr, vbNullChar)
'''''''''''''''''''''''''''''''''''''''
' Join will set ItemValue to a string
' regardless of what the original
' data type was. Test the VTypes(Ndx)
' value to convert ItemValue back to
' the proper data type.
'''''''''''''''''''''''''''''''''''''''
Select Case VTypes(Ndx)
Case vbBoolean
ItemValue = CBool(ItemValue)
Case vbByte
ItemValue = CByte(ItemValue)
Case vbCurrency
ItemValue = CCur(ItemValue)
Case vbDate
ItemValue = CDate(ItemValue)
Case vbDecimal
ItemValue = CDec(ItemValue)
Case vbDouble
ItemValue = CDbl(ItemValue)
Case vbInteger
ItemValue = CInt(ItemValue)
Case vbLong
ItemValue = CLng(ItemValue)
Case vbSingle
ItemValue = CSng(ItemValue)
Case vbString
ItemValue = CStr(ItemValue)
Case Else
ItemValue = ItemValue
End Select
''''''''''''''''''''''''''''''''''''''
' Finally, add the Item and Key to
' our TempDict dictionary.
TempDict.Add Key:=KeyValue, Item:=ItemValue
Next Ndx
End If
'''''''''''''''''''''''''''''''''
' Set the passed in Dict object
' to our TempDict object.
'''''''''''''''''''''''''''''''''
Set Dict = TempDict
End Sub
答案 1 :(得分：1)
John Bustos的答案很好。排序使得一个无证的假设你的dictionary.keys都是字符串。在我的情况下，键是整数。我在SortDictionary的加载部分中进行了转换更改：
' Load TempDict. The key value come from
' our sorted array of keys Arr, and the
' Item comes from the original Dict object.
''''''''''''''''''''''''''''''''''''''''''''
For Ndx = 0 To Dict.Count - 1
KeyValue = Arr(Ndx)
'MsgBox "key: " & KeyValue & "Item Value: " & Dict.Item(CInt(KeyValue))
TempDict.Add Key:=KeyValue, Item:=Dict.Item(CInt(KeyValue))'Convert here
Next Ndx
此外，您需要QSortInPlace才能使此代码正常工作。如果作者的链接在某一天死亡，则链接jsfiddle。代码太长，无法直接发布到SO中。