與之前寫過的《Excel·VBA數(shù)組冒泡排序函數(shù)》不同，不是按照數(shù)值大小的升序/降序?qū)?shù)組進行排序，而是按照指定數(shù)組的順序，對另一個數(shù)組進行排序

以下代碼調(diào)用了《Excel·VBA數(shù)組冒泡排序函數(shù)》bubble_sort_arr函數(shù)（如需使用代碼需復(fù)制）

Function 按指定順序排序(ByVal sorted, ByVal arr, Optional ByVal key_col& = 1, Optional start As Boolean = False)
    'sorted已排序的數(shù)組，arr數(shù)組第key_col列將按sorted順序排序，arr如果是一維數(shù)組則key_col無意義，key_col從1開始計數(shù)
    'start參數(shù)為True時，arr數(shù)組第key_col列值的開頭符合sorted中的值，也進行排序；否則排在最后（匹配模式）
    'sorted數(shù)組可以是一維或二維，都會讀取為字典（從上往下從左往右順序）；返回數(shù)組從1開始計數(shù)
    Dim dict As Object, x&, a, c&, dc&, i&, j&, temp, result
    Set dict = CreateObject("scripting.dictionary"): On Error Resume Next
    For Each s In sorted  'sorted數(shù)組轉(zhuǎn)換為字典，鍵為字符串，值為順序號
        If Not dict.Exists(s) Then x = x + 1: dict(s) = x
    Next
    x = 0: dc = dict.Count: a = TypeName(UBound(arr, 2))  '利用報錯判斷，獲取數(shù)組維數(shù)
    If a = "" Then  'arr為一維數(shù)組
        c = UBound(arr) - LBound(arr) + 1: ReDim temp(1 To c, 1 To 2): ReDim result(1 To c)
        For Each a In arr  'temp數(shù)組，第1列為對應(yīng)arr的值，第2列為排序序號
            x = x + 1: temp(x, 1) = a
            For Each k In dict.keys
                If a = k Then
                    temp(x, 2) = dict(k): Exit For    '全部相同，使用排序序號
                ElseIf start And a Like k & "*" Then  '開頭符合，使用排序序號+0.1
                    temp(x, 2) = dict(k) + 0.1: Exit For
                End If
            Next
            If Len(temp(x, 2)) = 0 Then temp(x, 2) = dc + 1  '都不符合，排在最后
        Next
        temp = bubble_sort_arr(temp, 2)  '調(diào)用函數(shù)排序
        For x = 1 To c  '排序結(jié)果寫入result數(shù)組，并輸出
            result(x) = temp(x, 1)
        Next
        按指定順序排序 = result
    Else  'arr為二維數(shù)組
        If LBound(arr) = 0 Or LBound(arr, 2) = 0 Then  '轉(zhuǎn)為從1開始計數(shù)
            arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
        End If
        c = UBound(arr): ReDim temp(1 To c, 1 To 2): ReDim result(1 To c, 1 To UBound(arr, 2))
        For x = 1 To c  'temp數(shù)組，第1列為對應(yīng)arr的序號，第2列為排序序號
            temp(x, 1) = x: a = arr(x, key_col)  'key_col從1開始計數(shù)
            For Each k In dict.keys
                If a = k Then
                    temp(x, 2) = dict(k): Exit For    '全部相同，使用排序序號
                ElseIf start And a Like k & "*" Then  '開頭符合，使用排序序號+0.1
                    temp(x, 2) = dict(k) + 0.1: Exit For
                End If
            Next
            If Len(temp(x, 2)) = 0 Then temp(x, 2) = dc + 1  '都不符合，排在最后
        Next
        temp = bubble_sort_arr(temp, 2)  '調(diào)用函數(shù)排序
        For i = 1 To c  '排序結(jié)果寫入result數(shù)組，并輸出
            x = temp(i, 1)
            For j = 1 To UBound(arr, 2)
                result(i, j) = arr(x, j)
            Next
        Next
        按指定順序排序 = result
    End If
End Function

• 舉例1

Sub 排序測試1()
    Dim arr, brr, crr
    '一維數(shù)組
    arr = Array("A", "B", "C", "D", "E", "F")
    brr = Array("AA", "C", "BB", "B", "CC", "A")
    crr = 按指定順序排序(arr, brr)
    [e1].Resize(1, UBound(crr)) = crr  '一維數(shù)組單行輸出
    '二維數(shù)組
    arr = [a1].CurrentRegion: brr = [c1].CurrentRegion
    crr = 按指定順序排序(arr, brr)
    [e1].Resize(UBound(crr), UBound(crr, 2)) = crr  '二維數(shù)組單列輸出
End Sub

start參數(shù)為默認值False，字符串完全相同時確定序號

start參數(shù)為True，使用開頭匹配模式，字符串完全相同或開頭相同時確定序號，結(jié)果與上面不同

• 舉例2

Sub 按指定順序排序_測試()
    Dim arr, brr, crr
    arr = [a1].CurrentRegion: brr = [c1].CurrentRegion
    crr = 按指定順序排序(arr, brr, , True)  '開頭匹配模式
    [f1].Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

start參數(shù)為True，使用開頭匹配模式，字符串完全相同或開頭相同時確定序號
文章來源地址http://www.zghlxwxcb.cn/news/detail-824169.html

到了這里，關(guān)于Excel·VBA按指定順序排序函數(shù)的文章就介紹完了。如果您還想了解更多內(nèi)容，請在右上角搜索TOY模板網(wǎng)以前的文章或繼續(xù)瀏覽下面的相關(guān)文章，希望大家以后多多支持TOY模板網(wǎng)！