Cacher is the code snippet organizer for pro developers

[1]xlsm中，排序
①data1的sheet中，对应“填入combo”的d_a_中：
恢复顺序	Sheet3.sort1
按紧要、时间排序	Sheet3.sort2
按时间、紧要排序	Sheet3.sort3

②data1的sheet中，的d_sort_1中，（先后是按从上到下的顺序排列的）：		
sort1	sort2	sort3
serial	紧要	t_require
	t_require	紧要
③vba
Function sortmain(col1)
    Application.ScreenUpdating = 0
    Call show_r_c_all
    Dim arr1()
    arr1 = get_data_arr("data_sort_1", col1)
    Sheets("杂项").Activate
    ActiveSheet.Sort.SortFields.Clear
    For Each i In arr1
        ActiveSheet.Sort.SortFields.Add Key:=Range(fc_s(i, 2) & ":" & fc_s(i, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Next
    'ActiveWorkbook.Worksheets("data1").Sort.SortFields.Clear
    'ActiveWorkbook.Worksheets("data1").Sort.SortFields.Add Key:=Range("E2:E5"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A2:" & fc_s("serial", 2) & eu(65536, fc("item", 2)))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Function

Sub sort1()
sortmain (1)
End Sub
Sub sort2()
sortmain (2)
End Sub
Sub sort3()
sortmain (3)
End Sub

[1]有正则的排序
[2]
Sub A列有正则的全覆盖的自定义排序() 'array中的项，能全部匹配的情况，否则得到的会缺少
    arr = [a1].CurrentRegion
    brr = Array("*信*", "*广*", "*上*", "*玉*", "*铅*")
    ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
    m = 0
    For Each c In brr
      For i = 3 To UBound(arr) '从第三行开始匹配
        If arr(i, 1) Like c Then
          m = m + 1
          For j = 1 To UBound(arr, 2)
            crr(m, j) = arr(i, j)
          Next
        End If
      Next
    Next
    [c3].Resize(m, j) = crr '单独列出排序后的列
End Sub
Sub 选中行有正则的不全覆盖的自定义排序() 'array中的项，能全部匹配的情况，否则得到的会缺少
    a1 = Selection.row
    a2 = a1 + Selection.Rows.Count - 1
    arr = Range("a" & a1 & ":z" & a2)
    brr = Array("先", "10") '此处其实应两列分别匹配，但较麻烦，所以此处简写
    lv = UBound(arr)
    lh = UBound(arr, 2)
    ReDim crr(1 To lv, 1 To lh)
    k1 = fc("tab", 2)
    k2 = fc("urg_imp", 2)
    m = 0
    brr = arr1to2(brr)
    For i = 1 To lv
        For j = 1 To 12
        If DofArray(InArr2(arr(i, k1), brr, 1)) > 0 Or DofArray(InArr2(arr(i, k2), brr, 1)) > 0 Then '此处需要inarr2和dofarray两个函数，一个判断匹配是否在数组中，另一个判断前一个函数返回数组的维数。
            If j = 1 Then m = m + 1
            crr(m, j) = arr(i, j)
        Else
            crr(UBound(arr) - (i - 1) + m, j) = arr(i, j) '不匹配的，从末端开始，即倒序
        End If
        Next
    Next
    Range("a" & a1).Resize(lv, lh) = crr '单独列出排序后的列
End Sub
Function InArr2(ByVal v, ByRef a, Optional mode = 0)
    If v = "" Then
        InArr2 = ""
        Exit Function
    End If
    Dim t
    For i = 1 To UBound(a)
        For j = 1 To UBound(a, 2)
        If mode = 0 Then
            If v = a(i, j) Then
                InArr2 = Array(i, j)
                Exit Function
            End If
        Else
            If a(i, j) Like "*" & v & "*" Then
                InArr2 = Array(i, j)
                Exit Function
            End If
        End If
        Next
    Next
    InArr2 = ""
End Function
Function arr1to2(arr)
    lv = UBound(arr) + 1 '注意一维数组和维数的起始数字的不同
    ReDim arr1(1 To lv, 1 To 2)
    For i = 1 To lv
        arr1(i, 1) = arr(i - 1)
    Next
    arr1to2 = arr1
End Function
Function DofArray(arr) As Integer
    On Error Resume Next
    '判断是否数组
    If Not IsArray(arr) Then
        DofArray = -1
        Exit Function
    End If
    '利用出错来判断
    For i = 1 To 60
        aa = UBound(arr, i)
        If Err.Number <> 0 Then
            DofArray = i - 1
            Exit Function
        End If
    Next
End Function
Function reverse_arr(arr,optional m = 1)
    lv = UBound(arr)
    lh = UBound(arr, 2)
    Dim crr()
    ReDim crr(1 To lv, 1 To lh)
    For i = 0 To Int((lv - m) / 2) - 1
        For j = 1 To lh
        tmp1 = crr(m + i, j)
        crr(m + i, j) = crr(lv - i, j)
        crr(lv - i, j) = tmp1
        Next
    Next
    reverse_arr = crr
End Function