jkluio668
2/9/2018 - 12:07 AM

arr_dic1

Function InArr(ByVal v, ByRef a) As Boolean
    Dim t
    InArr = True
    For Each t In a
        If v = t Then Exit Function
    Next t
    InArr = False
End Function

Function InArr2(ByVal v, ByRef a, Optional mode = 0)
    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 match_arr(arr1, con, col) '匹配数组的第几行
    Dim l
    l = Application.Match(con, Application.Index(arr1, , col), 0)
    match_arr = l '返回第几行
End Function
Function match_arr_con(arr1, con, col1, col2) '匹配数组的第几行的内容
    Dim l, s1
    l = Application.Match(con, Application.Index(arr1, , col1), 0)
    match_arr_con = arr1(l, col2)
    'match_arr_con = s1 '返回内容
End Function

'备用
Function clean_to_dic(ByVal arr1) As Object '清除换行,并转为字典
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1)
        On Error Resume Next
        dic.Add arr1(i), Application.WorksheetFunction.Clean(arr1(i))
        On Error Resume Next
        dic.Add Application.WorksheetFunction.Clean(arr1(i)), arr1(i) 'key和item都作为key,以反向快速查找
    Next
    Set clean_to_dic = dic '用set,返回字典
End Function


    Dim dic2
    Dim n_tmp1 As Long
    Set dic2 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1)
        On Error Resume Next
        n_tmp1 = fc(ActiveSheet.Cells(1, i), , "Worksheet")
        If Not Err > 0 Then dic2.Add i, n_tmp1
    Next