VBA 对象数组排序算法分享

vba,对象,数组,排序,算法,分享 · 浏览次数 : 71

小编点评

```vba Function SrotObjectByProperty(objsToSort As Variant, PropertyName As String, Optional 降序 As Boolean = True) ' Check if the input array is empty. If IsEmpty(objsToSort) Then Exit Function ' Check if the property name contains parentheses. If InStr(TypeName(objsToSort), "\()") < 1 Then Exit Function ' IsArray() is somewhat broken: Look for brackets in the type name ' Initialize variables for comparison. Dim m As Long, n As Long, compareRtn As Integer Dim temp As Variant, temp1 As Variant ' Loop through the objects in the array. For m = LBound(objsToSort) To UBound(objsToSort) For n = m To UBound(objsToSort) ' Get the values of the property named PropertyName. nValue = CallByName(objsToSort(n), PropertyName, VbGet) mValue = CallByName(objsToSort(m), PropertyName, VbGet) ' Compare the values in numerical order. compareRtn = VBA.StrComp(nValue, mValue, vbTextCompare) ' Swap elements if necessary. If VBA.IsNumeric(nValue) And nValue < mValue And 降序 Then ' Swap elements if they are in the wrong order and 降序为true. Set objsToSort(n) = temp1 Set objsToSort(m) = temp ElseIf nValue > mValue And Not 降序 Then ' Swap elements if they are in the wrong order but 降序为false. Set objsToSort(n) = temp1 Set objsToSort(m) = temp ElseIf compareRtn = -1 And 降序 Then ' Swap elements if they are in the wrong order but 降序为false. Set objsToSort(n) = temp1 Set objsToSort(m) = temp ElseIf compareRtn = 1 And Not 降序 Then ' Swap elements if they are in the wrong order but 降序为true. Set objsToSort(n) = temp1 Set objsToSort(m) = temp End If Next n Next m End Function ```

正文

 

Function SrotObjectByProperty(objsToSort As Variant, PropertyName As String, Optional 降序 As Boolean = True)
    If IsEmpty(objsToSort) Then Exit Function
    If InStr(TypeName(objsToSort), "()") < 1 Then Exit Function 'IsArray() is somewhat broken: Look for brackets in the type name
    Dim m As Long, n As Long, compareRtn As Integer
    Dim temp As Variant, temp1 As Variant
    For m = LBound(objsToSort) To UBound(objsToSort)
        For n = m To UBound(objsToSort)
            Set temp = objsToSort(n)
            Set temp1 = objsToSort(m)
            'https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-interface-help/strcomp-function
            Dim nValue As Variant, mValue As Variant
            nValue = CallByName(objsToSort(n), PropertyName, VbGet)
            mValue = CallByName(objsToSort(m), PropertyName, VbGet)
            compareRtn = VBA.StrComp(nValue, mValue, vbTextCompare)
            If VBA.IsNumeric(nValue) Then
                If nValue < mValue And 降序 Then
                    'ElementSwap objsToSort(n), objsToSort(m)
                    Set objsToSort(n) = temp1
                    Set objsToSort(m) = temp
                ElseIf nValue > mValue And Not 降序 Then
                    'ElementSwap objsToSort(n), objsToSort(m)
                    Set objsToSort(n) = temp1
                    Set objsToSort(m) = temp
                End If
            Else
                If compareRtn = -1 And 降序 Then
                    'ElementSwap objsToSort(n), objsToSort(m)
                    Set objsToSort(n) = temp1
                    Set objsToSort(m) = temp
                ElseIf compareRtn = 1 And Not 降序 Then
                    'ElementSwap objsToSort(n), objsToSort(m)
                    Set objsToSort(n) = temp1
                    Set objsToSort(m) = temp
                End If
            End If
        Next n
    Next m
End Function

 

 

与VBA 对象数组排序算法分享相似的内容: