jkluio668
1/13/2019 - 4:26 AM

sorted2 未测试

Function sorted2(arr_str1, _
    Optional ByVal rb = "", Optional ByVal re = "", _
    Optional ByVal c_b_s = "a", Optional ByVal c_e_s = "", _
    Optional ByVal r_refer = 1, Optional ByVal sh_to = "")
    '---
    'arg:r_refer,为arr_str1的所在的行,默认为第一行
    '---
    If sh_to = "" Then sh_to = ActiveSheet.Name
    Set sh1 = Sheets(sh_to)
    '---
    Application.ScreenUpdating = False
    '---
    sh1.Activate
    ActiveSheet.Sort.SortFields.Clear
    If rb = "" Then rb = 2
    If re = "" Then re = Cells(65536, 1).End(xlUp).row
    If c_e_s = "" Then c_e_s = Split(Cells(1, Cells(1, 50).End(xlToLeft).Column).Address, "$")(1)
    arr1 = Split(arr_str1, "  ")
    For Each i In arr1
        order1 = 1
        If Right(i, 1) = "↓" Then
            order1 = 2
        End If
        i = Replace(i, "↓", "")
        ActiveSheet.Sort.SortFields.Add Key:=Range(fc_s(i, r_refer) & ":" & fc_s(i, r_refer)) _
            , SortOn:=xlSortOnValues, Order:=order1, DataOption:=xlSortNormal
    Next
    '---
    '判断c_b_s、c_e_s,都是否是数字,如果是就转为字母
    If IsNumeric(c_b_s) Then c_b_s = Split(Cells(1, c_b_s).Address, "$")(1)
    If IsNumeric(c_e_s) Then c_e_s = Split(Cells(1, c_e_s).Address, "$")(1)
    '---
    With ActiveSheet.Sort
        .SetRange Range(c_b_s & rb & ":" & c_e_s & re)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Function