自定义按类别排序集合类

Question

我有一个两难的问题，我不确定如何接近正面。我有三个类

A Segment类，它有一个字典Customer类，它又有Product类的字典。类别Customer的字典需要按SumPoundsSold的属性排序。

我真的不知道从哪里开始。任何提示？

我已经想通了，并在下面回答。还要感谢ainwood发布Chip Pearson的排序集合/字典的代码！

Answer 1

我想通了！

我可以发布该类的其余部分，但基本上它只涉及找到集合的最小值和最大值，然后在找到它之后将其删除，并重复该过程直到达到0计数。

这里是我的代码

Public Sub SortByVolume(Optional Descending As Boolean = True) 

    Dim TempDict As Dictionary 
    Dim benchMark As Double 'The benchmark to start with and go from there 

    Dim custCheck As Customer 'Customer to check during the loop 

    'Make sure the Dictionary isn't nothing 
    If sCustomers Is Nothing Then Exit Sub 

    'If the count is 0 or 1 we don't need a sort 
    If (sCustomers.Count = 0) Or (sCustomers.Count = 1) Then Exit Sub 

    'Create the temprary dictionary 
    Set TempDict = New Dictionary 

    'We need to loop through the Dictionary to get the highest Volume 
    'The Dictionary will load appending, so to descend we get the minimum value and build up, and vice versa for ascending 
    If Descending = False Then 
     benchMark = GetMaxVolume 
    Else 
     benchMark = GetMinVolume 
    End If 

    'Do everything until the benchmark is matched 
    'Load everything into the TempDict, removing it from the original 
    Do While sCustomers.Count > 0 

     For Each pKey In sCustomers.Keys 

      Set custCheck = sCustomers(pKey) 
      If custCheck.SumPoundsSold = benchMark Then 
       'benchmark has been met. Load this customer into TempDict 
       TempDict.Add custCheck.Name, custCheck 
       sCustomers.Remove pKey 'Remove the customer 
       benchMark = IIf(Descending = True, GetMinVolume, GetMaxVolume) 
       Set custCheck = Nothing 
       Exit For 
      End If 

     Next pKey 

    Loop 

    'Set the Class' customer dictionary to the Temporary Dictionary 
    Set sCustomers = TempDict 

    'Set the TempDict to nothing 
    Set TempDict = Nothing 


End Sub 

Public Function GetMaxVolume() As Double 

    Dim highVol As Double: highVol = 0 
    Dim checkCust As Customer 

    For Each pKey In sCustomers.Keys 
     Set checkCust = sCustomers(pKey) 
     If checkCust.SumPoundsSold > highVol Then 
      highVol = checkCust.SumPoundsSold 
     End If 
    Next pKey 

    GetMaxVolume = highVol 

End Function 

Public Function GetMinVolume() As Double 

    Dim lowVol As Double: lowVol = 1.79769313486232E+307 
    Dim checkCust As Customer 

    For Each pKey In sCustomers.Keys 
     Set checkCust = sCustomers(pKey) 
     If checkCust.SumPoundsSold <= lowVol Then 
      lowVol = checkCust.SumPoundsSold 
     End If 
    Next pKey 

    GetMinVolume = lowVol 

End Function 

Answer 2

Chip Pearson有This really good page on VBA Dictionaries。它包括如何将集合，数组和范围转换为字典（或彼此），以及如何对字典进行排序。对于字典排序

的（！相当长的），代码如下：

用途：

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 

注意的QSortInPlace规范要求。我不会在这里粘贴...你可以从This Link