VBA/Excel-实例系列-04-求两个数组的交集

原创： Z Excel高效办公之VBA 2017-03-10

Part 1：逻辑过程

1. 已有两个数组，要求单个数组中信息无重复

2. 以最短的数组作为循环，分别判断该数组中的元素是否在另一个数组中

3. 如果某一元素在另外一个数组中，则将其保存到结果数组中

Part 2：代码

Function funIntersection(array1, array2)
    Rem>>求两个集合的交集
    Rem>>要求原数组无重复信息

    Dim len1
    Dim len2
    Dim cycle
    Dim cycleArray
    Dim findArray
    Dim resultArray()
    Dim eachOne
    Dim i
    Dim findStatus
    Dim resultLen

    len1 = UBound(array1)
    len2 = UBound(array2)

    resultLen = 0

    '以最小数组循环，减少循环次数
    If len1 >= len2 Then
        cycle = len2
        cycleArray = array2
        findArray = array1
    Else
        cycle = len1
        cycleArray = array1
        findArray = array2
    End If

    For i = 0 To cycle Step 1
        eachOne = cycleArray(i)
        findStatus = Application.Match(eachOne, findArray, 0)
        If Not IsError(findStatus) Then
            resultLen = resultLen + 1
            ReDim Preserve resultArray(1 To resultLen)
            resultArray(resultLen) = eachOne
        End If

    Next

    funIntersection = resultArray
End Function

Part 3：部分代码解读

ReDim Preserve resultArray(1 To resultLen)改变数组resultArray的大小

• 同时保存数组已有的信息

• 数组下标从1开始，数组下标默认从0开始，可以人为修改

Part 4：调用该函数

Sub test()
    Rem>>
    Rem>>
    Dim array1()
    Dim array2()
    Dim array3()
    Dim array4()
    Dim array5()
    Dim array12()
    Dim array13()
    Dim array45()
    Dim inersectionCount

    array1 = Array("张三", "李四", 1, 2, 3, 4, 5)
    array2 = Array("张三", "王五", 3, 4, 5, 6)
    array3 = Array(11, 12)
    array4 = Array(1, 2, 3, 4, 5, 6)
    array5 = Array(4, 5, 6, 7, 8)


    array12 = funIntersection(array1, array2)
    array13 = funIntersection(array1, array3)
    array45 = funIntersection(array4, array5)

    Err.Clear
    On Error Resume Next
    inersectionCount = UBound(array13)
    If Err.Number <> 0 Then
        MsgBox "空数组"
    End If
    On Error GoTo 0
End Sub

执行结果