一直想學下自定義排序，之前有了解到sort方法排序和一個個對比的排序方法，今天遇到個需要按固定順序來排序的問題，所以一時興起就去網上找了下答案。

排序後結果

程式碼片段:

Sub order_by_customize()
    Dim ws As Worksheet
    Dim arr(), brr()
    Dim d As Object
    Dim r(), i&, j&, k&, ra As Range
    Set ws = ActiveWorkbook.Worksheets("排序測試")
    Set d = CreateObject("scripting.dictionary")
    
    j = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    i = ws.Cells(Rows.Count, "B").End(xlUp).Row
    '將目標自定義排序列資料寫入陣列,這裡我把指定序列 先放到G列下面空白的地方了
    r() = ws.Range("B21:B" & i).Value
    
    k = 1
    '自定義排序的陣列寫入字典，序號作為item
    For k = 1 To UBound(r())
        d(r(k, 1)) = k
    Next
    
    i = ws.Cells(Rows.Count, 1).End(xlUp).Row
    '資料來源寫入陣列
    arr() = ws.Range(ws.Cells(2, 1), ws.Cells(i, j)).Value
    
    '建立另一個數組,用來記錄排序的序列號
    ReDim brr(1 To UBound(arr()), 1 To 1)
    
    k = 1
    For k = 1 To UBound(arr())
        '將自定義排序的序號寫入陣列brr, 我想要排序的被排序的列在第1列
        If d.exists(arr(k, 1)) Then

            brr(k, 1) = d(arr(k, 1))
        Else
            brr(k, 1) = "指定序列不存在"
        End If
    Next k
    
    '將新的序號放在最後一列
    ws.Cells(2, j + 1).Resize(UBound(brr()), 1) = brr
    
    Set ra = ws.Range(ws.Cells(1, 1), ws.Cells(i, j + 1))
    
    'sort方法排序
    ra.Sort key1:=ws.Cells(2, j + 1), order1:=xlAscending, Header:=xlYes
    
    '刪除輔助排序的列
    ws.Range(ws.Cells(1, j + 1), ws.Cells(i, j + 1)).Delete
    
    Set d = Nothing

End Sub

　　學習參考的網頁:http://www.excelhome.net/lesson/article/excel/1927.html