VBAExcel-实例系列-04-求两个数组的交集原创： Z Excel⾼效办公之VBA 2017-03-10
Part 1：逻辑过程
1. 已有两个数组，要求单个数组中信息⽆重复
2. 以最短的数组作为循环，分别判断该数组中的元素是否在另⼀个数组中
3. 如果某⼀元素在另外⼀个数组中，则将其保存到结果数组中
Part 2：代码
Function funIntersection(array1, array2)
excel数组函数的实例
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 = 0To cycle Step1
eachOne = cycleArray(i)
findStatus = Application.Match(eachOne, findArray, 0)
If Not IsError(findStatus) Then
resultLen = resultLen + 1
ReDim Preserve resultArray(1To resultLen)
resultArray(resultLen) = eachOne
End If
Next
funIntersection = resultArray
End Function
Part 3：部分代码解读
ReDim Preserve resultArray(1To 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 <> 0Then
MsgBox"空数组"
End If
On Error GoTo0
End Sub
执⾏结果

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。