VBA 2个数组之间的补集

wps6129

VBA 2个数组之间的补集（差集）

在使用VBA 的时候， 需要求出 新, 旧 两个集合的补集， 也就是新集合中不同于旧集合的地方。
比较完成后，结果返回到Comparison_Array()数组里。

1. Function ListComplement(Array_A, new_Array)
   
2. 
   
3. Dim i As Integer
   
4. Dim rn As Integer: rn = Range("A65536").End(xlUp).Row   '
   
5. Dim Comp_str As String
   
6. Dim Comp_arr
   
7. 
   
8. If (Not IsEmpty(Array_A)) Then                      '当A 为 非空的时候
   
9. 
   
10.     If (Not IsEmpty(new_Array)) Then                    '当new 为 非空的时候
    
11.    
    
12.         For i = 1 To UBound(new_Array)
    
13. 
    
14.             If IsError(Application.Match(new_Name(i), Array_A, 0)) = True Then    ' 在A 数组里， 寻找new(i)是否存在
    
15.    
    
16.                 Comp_str = Comp_str & new_Name(i) & ","
    
17.    
    
18.             End If
    
19.    
    
20.         Next
    
21.                 If Len(Comp_str) >= 1 Then
    
22.                     Comp_arr = Left(Comp_str, Len(Comp_str) - 1)
    
23.                     Comp_arr = Split(Comp_arr, ",")                   'Split() 生成的数组，index从0 开始
    
24.                     Comp_str = ""                                      
    
25.                     Range("B" & rn + 1).Resize(UBound(Comp_arr) - LBound(Comp_arr) + 1, 1) = Application.WorksheetFunction.Transpose(Comp_arr)
    
26.                 Else
    
27.                     MsgBox "added Documents are already in the list"
    
28.                 End If
    
29.     Else
    
30.         If IsEmpty(new_Array) Then                '当new 为 空的时候
    
31.             
    
32.                 Exit Function
    
33.         End If
    
34.         
    
35.     End If
    
36. 
    
37. Else                                             '当A 为 空的时候
    
38. 
    
39.     If (Not IsEmpty(new_Array)) Then              '当new 为 非空的时候
    
40.             Comp_arr = new_Array
    
41.             Range("B" & rn + 1).Resize(UBound(Comp_arr) - LBound(Comp_arr) + 1, 1) = Application.WorksheetFunction.Transpose(Comp_arr)
    
42. 
    
43.     Else: Exit Function
    
44.     End If
    
45.             
    
46. End If
    
47. 
    
48. End Function

复制代码