Excel 按类属性对集合进行自定义排序

我左右为难，不知道该如何面对。我有三节课

一个段类，它有一个客户类的字典，而客户类又有一个产品类的字典。客户类字典需要按sumpoondsold属性排序

我真的不知道从哪里开始。有什么提示吗

我已经弄明白了，并在下面给出了答案。还要感谢安伍德发布了Chip Pearson的集合/词典分类代码

奇普·皮尔森已经成功了。它包括如何将集合、数组和范围转换为字典或相互转换，以及如何对字典进行排序

这条路相当长！字典排序的代码如下所示：

使用：

请注意QSortInPlace代码的要求。我不会把它贴在这里。。。你可以从

那里得到它，我想出来了

我可以发布类的其余部分，但基本上它只涉及找到集合的最小值和最大值，然后在找到集合后将其删除，并重复此过程，直到达到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

---

好吧，你的解决方案是可行的，但是会产生额外的不必要的循环，并且它使用了不必要的辅助函数

由于在VBA中对字典和集合进行排序有点混乱，因此最好使用用于排序的临时数组

整个过程将是：

检查输入并管理可选参数 初始化辅助数组以对元素进行排序 对数组中的元素进行排序 使用已排序的数组构建新词典 在下面的示例中，我刚刚添加了一个可选参数，以使函数可用于除sCusomters变量以外的客户词典：

Public Function SortByVolume(Optional Descending As Boolean = True, _
    Optional dicCustomers As Object = Nothing) As Object

 Dim blnInputParam As Boolean
 Dim pKey As Variant, I As Integer, J As Integer
 Dim arrSort() As Customer, blnSwap as Boolean
 Dim cusPosI As Customer, cusCur As Customer
 Dim dicTemp As Object

 On Error Resume Next

 Set SortByVolume = Nothing

 ' allow to use the function with other customer dictionaries
 blnInputParam = True
 If dicCustomers Is Nothing Then
    blnInputParam = False
    Set dicCustomers = sCustomers
 End If

 ' validate
 If dicCustomers is Nothing Then Exit Function
 If dicCustomers.Count = 0 Then Exit Function

 ' populate array
 ReDim arrSort(dicCustomers.Count - 1)
 I = 0
 For Each pKey In dicCustomers.Keys
    Set arrSort(I) = dicCustomers(pKey)
    I = I + 1
 Next

 ' sort array
 For I = LBound(arrSort) To UBound(arrSort) - 1
    Set cusPosI = arrSort(I)
    For J = I + 1 To UBound(arrSort)
        Set cusCur = arrSort(J)

        blnSwap = _
          (Descending AND (cusCur.SumPoundsSold > cusPosI.SumPoundsSold)) OR _
          ((Not Descending) AND (cusCur.SumPoundsSold < cusPosI.SumPoundsSold)

        If blnSwap Then
            Set arrSort(J) = cusPosI
            Set arrSort(I) = cusCur
            Set cusPosI = cusCur
        End If
    Next
 Next

 ' prepare output dictionary
 Set dicTemp = CreateObject("Scripting.Dictionary")
 dicTemp.CompareMode = BinaryCompare

 For I = LBound(arrSort) To UBound(arrSort)
    Set cusPosI = arrSort(I)
    dicTemp.Add cusPosI.pKey, cusPosI
 Next

 ' if input param wasn't used, set to default customers' dictionary
 If Not blnInputParam Then Set sCustomers = dicTemp
 Set SortByVolume = dicTemp
End Function

---

我知道这是一个旧线程，但我也有这个需要，我的线程增加了按索引排序数组属性。但这是最后一个可选参数，它也适用于OP问题

所以，虽然我使用了这个线程中的东西，非常有用，但我不喜欢使用字典——大量的遗留代码已经构建在纯集合中了…-我主要改编自和的代码

---

希望它能帮助别人。

完全意识到这是一个模糊的问题。但这就是我目前所拥有的一切。一旦我做出了更有力的尝试，我会发布代码，也许可以帮助你们。我确实看过芯片的功能，但我担心这太过分了。事实上，我有一个快速排序的方法来解决！我很快就会寄出去的。不过，谢谢你的帖子！奇普就是那个人

Public Function SortByVolume(Optional Descending As Boolean = True, _
    Optional dicCustomers As Object = Nothing) As Object

 Dim blnInputParam As Boolean
 Dim pKey As Variant, I As Integer, J As Integer
 Dim arrSort() As Customer, blnSwap as Boolean
 Dim cusPosI As Customer, cusCur As Customer
 Dim dicTemp As Object

 On Error Resume Next

 Set SortByVolume = Nothing

 ' allow to use the function with other customer dictionaries
 blnInputParam = True
 If dicCustomers Is Nothing Then
    blnInputParam = False
    Set dicCustomers = sCustomers
 End If

 ' validate
 If dicCustomers is Nothing Then Exit Function
 If dicCustomers.Count = 0 Then Exit Function

 ' populate array
 ReDim arrSort(dicCustomers.Count - 1)
 I = 0
 For Each pKey In dicCustomers.Keys
    Set arrSort(I) = dicCustomers(pKey)
    I = I + 1
 Next

 ' sort array
 For I = LBound(arrSort) To UBound(arrSort) - 1
    Set cusPosI = arrSort(I)
    For J = I + 1 To UBound(arrSort)
        Set cusCur = arrSort(J)

        blnSwap = _
          (Descending AND (cusCur.SumPoundsSold > cusPosI.SumPoundsSold)) OR _
          ((Not Descending) AND (cusCur.SumPoundsSold < cusPosI.SumPoundsSold)

        If blnSwap Then
            Set arrSort(J) = cusPosI
            Set arrSort(I) = cusCur
            Set cusPosI = cusCur
        End If
    Next
 Next

 ' prepare output dictionary
 Set dicTemp = CreateObject("Scripting.Dictionary")
 dicTemp.CompareMode = BinaryCompare

 For I = LBound(arrSort) To UBound(arrSort)
    Set cusPosI = arrSort(I)
    dicTemp.Add cusPosI.pKey, cusPosI
 Next

 ' if input param wasn't used, set to default customers' dictionary
 If Not blnInputParam Then Set sCustomers = dicTemp
 Set SortByVolume = dicTemp
End Function

set myDicOfCustomers = SortByVolume(dicCustomers:=myDicOfCustomers)
set myDicOfCustomers = SortByVolume(Descending:=False, dicCustomers:=myDicOfCustomers)

' and you can still launch it against your default dictionary of customers like this
SortByVolume 
SortByVolume Descending:=False

Public Function SortIt(ByVal col As Collection, ByVal SortPropertyName As String _
            , ByVal AsAscending As Boolean, Optional ByVal KeyPropertyName As String _
            , Optional ByVal CallByNameArg As Variant) As Collection

Dim this As Object
Dim i As Integer, j As Integer
Dim MinMaxIndex As Integer
Dim MinMax As Variant, thisValue As Variant
Dim SortCondition As Boolean
Dim UseKey As Boolean, thisKey As String

    UseKey = (KeyPropertyName <> "")
    For i = 1 To col.Count - 1
        Set this = col(i)
        If IsMissing(CallByNameArg0) Then
            MinMax = CallByName(this, SortPropertyName, VbGet)
        Else
            MinMax = CallByName(this, SortPropertyName, VbGet, CallByNameArg)
        End If
        MinMaxIndex = i
        For j = i + 1 To col.Count
            Set this = col(j)
            If IsMissing(CallByNameArg0) Then
                thisValue = CallByName(this, SortPropertyName, VbGet)
            Else
                thisValue = CallByName(this, SortPropertyName, VbGet, CallByNameArg)
            End If
            If (AsAscending) Then
                SortCondition = (thisValue < MinMax)
            Else
                SortCondition = (thisValue > MinMax)
            End If
            If (SortCondition) Then
                MinMax = thisValue
                MinMaxIndex = j
            End If
            Set this = Nothing
        Next j
        If (MinMaxIndex <> i) Then
            Set this = col(MinMaxIndex)
            col.Remove MinMaxIndex
            If (UseKey) Then
                If IsMissing(CallByNameArg0) Then
                    thisKey = CallByName(this, KeyPropertyName, VbGet)
                Else
                    thisKey = CallByName(this, KeyPropertyName, VbGet, CallByNameArg)
                End If
                col.Add this, thisKey, i
            Else
                col.Add this, , i
            End If
            Set this = Nothing
        End If
        Set this = Nothing
    Next i
    Set SortIt = col
End Function