VBA自定義排序

EXCEL自定義排序最多只能有255個值,超過了就不能用自定義序列了,使用以下方法

求助excelhome論壇得出的答案

Sub 自定義排序()
Application.ScreenUpdating = False
'排序標準
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Dim rng, i%
rng = Sheets("查補排序").[a1].CurrentRegion
For i = 2 To UBound(rng)             '不含標題
        d(rng(i, 1)) = i        '序號
Next
'數據源
Dim arr, brr
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr, 2))
For i = 5 To UBound(arr, 2)       '不含標題
    If d.Exists(arr(1, i)) Then
        brr(i) = d(arr(1, i))      '序號
    Else
        brr(i) = "不存在"
    End If
Next
Set d = Nothing
Rows(1).Insert
[a1].Resize(1, UBound(brr)) = brr
[e1].Resize(UBound(arr) + 1, UBound(arr, 2)).Sort key1:=[e1], Orientation:=xlLeftToRight, order1:=xlAscending '按行排序，降序
Rows(1).Delete
Application.ScreenUpdating = True
MsgBox "排序完成"
End Sub