arr

Function arr_format(arr, Optional ByVal flag As String = "'x'")
    arr_end = Array()
    For Each sub_val In arr
        b = Replace(flag, "x", sub_val)
        arr_end = extend(arr_end, b)
    Next
    arr_format = arr_end
End Function


Function sht_to_sht(file_path, table_name, goal_sht, Optional ByVal flag1 = "")
  '可以拿到数据，所有项目都可以拿过来，然后自定义文本格式，避免ado识别文本和数据的混合数据类型为空；
  goal_sht.Cells.Clear
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  Set wkb = Workbooks.Open(file_path)
  Set sht1 = wkb.Sheets(table_name)
  
  row_num = sht1.Range("a1000000").End(xlUp).Row
  col_num = sht1.Range("xaz1").End(xlToLeft).Column
  
  arr1 = sht1.Range(Cells(1, 1).Address, Cells(row_num, col_num).Address).Value
  wkb.Close
  
  goal_sht.Range("a1").Resize(row_num, col_num) = arr1
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
  If flag1 <> "" Then
    col = flag1 & ":" & flag1
    goal_sht.Range(col).NumberFormatLocal = "@"
  
  End If

End Function


Function TransposeArray(arrA) As Variant
    Dim aRes()
    If VBA.IsArray(arrA) Then
        ReDim aRes(LBound(arrA, 2) To UBound(arrA, 2), LBound(arrA, 1) To UBound(arrA, 1))
        For i = LBound(arrA, 1) To UBound(arrA, 1)
            For j = LBound(arrA, 2) To UBound(arrA, 2)
                aRes(j, i) = arrA(i, j)
            Next
        Next
        TransposeArray = aRes
    End If
End Function

Function arr_columns(arr, num)

    a = UBound(arr)
    b = LBound(arr)
    c = arr_width(arr)
    
    If b = 1 Then
        ReDim arr2(c - 1)
        For i = 1 To c
            arr2(i - 1) = arr(num, i)
        Next
    Else
        ReDim arr2(c - 1)
        For i = 0 To c - 1
            arr2(i) = arr(num, i)
        Next
    End If
    
    arr_columns = arr2


End Function


Function arr_rows(arr, num)

    a = UBound(arr)
    b = LBound(arr)
    
    If b = 0 Then
        ReDim arr2(a)
        For y = 1 To a
            arr2(y - 1) = arr(y, num)
        Next
    Else
        ReDim arr2(a - 1)
        For y = 1 To a
            arr2(y - 1) = arr(y, num)
        Next
    End If
    
    arr_rows = arr2
    
End Function
Function str_sort(arr1, Optional flag As String = "max")
'文本数组排序
arr_end = Array()

Set js = CreateObject("System.Collections.ArrayList")

For Each sub1 In arr1
    js.Add sub1
Next

js.Sort

For Each sub11 In js
    arr_end = extend(arr_end, sub11)
Next

If flag = "max" Then
    str_sort = arr_end(UBound(arr_end))
ElseIf flag = "min" Then
    str_sort = arr_end(LBound(arr_end))
Else
    str_sort = arr_end
End If
End Function

Function sort_values(arr1, Optional ByVal flag As String = "asc")
'只能对纯数字的数据完整排序（升序或者降序），如果包含字符，转换为0
    arr2 = Array()
    arr3 = arr1
    
    For i = LBound(arr1) To UBound(arr1)
        If flag = "desc" Then
            abc = Application.WorksheetFunction.Max(arr3)
        ElseIf flag = "asc" Then
            abc = Application.WorksheetFunction.Min(arr3)
        End If
        
        arr2 = extend(arr2, abc)
        arr3 = remove(arr3, abc)
    Next
    
    sort_values = arr2
End Function
Function remove(arr1, value1)
    arr2 = Array("-_")
    On Error Resume Next
    abc = Application.WorksheetFunction.Match(value1, arr1, 0)
    If abc > 0 Then
        arr1(abc - 1) = "-_"
        remove = inarr(arr1, arr2, 0)
    Else
        MsgBox "数组中无此元素"
    End If
End Function

Function count_num(arr1, a1, Optional ByVal flag As Integer = 0)
    Set dict1 = CreateObject("scripting.dictionary")
    For i = LBound(arr1) To UBound(arr1)
        dict1(arr1(i)) = dict1(arr1(i)) + 1
    Next
    
    If flag = 0 Then
        count_num = dict1(a1)
    ElseIf flag = 1 Then
        count_num = Application.Transpose(dict1.keys, dict1.items)
    End If
End Function
Function arr_width(arr)
    '判断二维数组的宽度aaa
    b = LBound(arr)
    aa = "-_"
    On Error Resume Next
    For y = b To 1000
        aa = arr(1, y)
        If aa = "-_" Then
            aaa = y
            Exit For
        Else
            aa = "-_"
        End If
    Next
    
    If b = 1 Then
        aaa = y - 1
    ElseIf b = 0 Then
        aaa = y + 1
    Else
        aaa = y
    End If
    arr_width = aaa
End Function
Function sht_to_arr(sht)
    row_num = sht.Range("a1000000").End(xlUp).Row
    col_num = sht.Range("xfd1").End(xlToLeft).Column
    
    sht_to_arr = sht.Range(Cells(2, 1).Address, Cells(row_num, col_num).Address).Value
End Function

Function duplicates(arr)
    '一维数组去重
    Set dict1 = CreateObject("scripting.dictionary")
    For i = LBound(arr) To UBound(arr)
        dict1(arr(i)) = 1
    Next
    duplicates = dict1.keys()
End Function

Function extend(arr1, arr2)
    If VarType(arr2) = 8204 Then
        '给arr1添加数组arr2
        a = UBound(arr1)
        b = UBound(arr2)
        ReDim Preserve arr1(a + b + 1)
        For y = a + 1 To a + b + 1
            arr1(y) = arr2(y - (a + 1))
        Next
    Else
        '给arr1添加单元素arr2
        a = UBound(arr1)
        ReDim Preserve arr1(a + 1)
        arr1(a + 1) = arr2
    End If
        extend = arr1
End Function

Function inarr(arr1, arr2, Optional ByVal flag As Integer = 1)

'1是包含,0是不包含
Dim arr3(), arr4()
not_num = 0
in_num = 0
arr2_v = Application.Transpose(arr2)
a = "-_"

On Error Resume Next
For Each x In arr1
    
    a = Application.WorksheetFunction.Match(x, arr2_v, 0)
    If a = "-_" Then
        ReDim Preserve arr3(not_num)
        arr3(not_num) = x
        not_num = not_num + 1
        
    Else
        ReDim Preserve arr4(in_num)
        arr4(in_num) = x
        in_num = in_num + 1
        a = "-_"
    End If
Next

a = -1
b = -1

a = UBound(arr4)
b = UBound(arr3)

If flag = 1 And a = -1 Then
    result = Nothing
ElseIf flag = 1 And a <> -1 Then
    result = arr4
ElseIf flag = 0 And b = -1 Then
    result = Nothing
ElseIf flag = 0 And b <> -1 Then
    result = arr3
End If

inarr = result
End Function


Function isin(str1, arr2)

'1是包含,0是不包含

arr2_v = Application.Transpose(arr2)
a = "-_"

On Error Resume Next

    
    a = Application.WorksheetFunction.Match(str1, arr2_v, 0)
    If a = "-_" Then
        result = False
        
    Else
        result = True
    End If


isin = result
End Function