如何通过字典等方法比较1~2个数组，得到一个新的数组

looselace

用if next循环搞了半天，没成功，请大师帮下忙！！！！

taller

swl4561255

1. Sub test()
   
2. arr = Range("B1").CurrentRegion
   
3. brr = Range("E1").CurrentRegion
   
4. Dim crr()
   
5. Set d1 = CreateObject("Scripting.Dictionary")
   
6. Set d2 = CreateObject("Scripting.Dictionary")
   
7. For i = 2 To UBound(brr)
   
8.     d2(brr(i, 1)) = brr(i, 2)
   
9. Next
   
10. For j = 2 To UBound(arr)
    
11.     If Not d2.exists(arr(j, 1)) Then
    
12.     m = m + 1
    
13.     ReDim Preserve crr(1 To 2, 1 To m)
    
14.         crr(1, m) = arr(j, 1)
    
15.         crr(2, m) = arr(j, 2)
    
16.     End If
    
17. Next
    
18. [H2].Resize(m, 2) = Application.Transpose(crr)
    
19. Set d1 = Nothing
    
20. Set d2 = Nothing
    
21. End Sub

复制代码

shiruiqiang

移除字典也行

今铭昔

无关岁月

如何通过字典等方法比较1~2个数组，得到一个新的数组.7z (15.72 KB, 下载次数: 4)

2024-4-6 09:06 上传

点击文件名下载附件

ykcbf1100

不用字典，仅数组比较

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.4.6
   
2.    arr = [b1].CurrentRegion
   
3.    brr = [e1].CurrentRegion
   
4.     ReDim crr(1 To UBound(arr), 1 To 2)
   
5.     k = 1
   
6.     For i = 2 To UBound(arr)
   
7.         ft = False
   
8.         For j = 2 To UBound(brr)
   
9.             If arr(i, 1) = brr(j, 1) And arr(i, 2) = brr(j, 2) Then
   
10.                 ft = True
    
11.                 Exit For
    
12.             End If
    
13.         Next j
    
14.         If Not ft Then
    
15.             crr(k, 1) = arr(i, 1)
    
16.             crr(k, 2) = arr(i, 2)
    
17.             k = k + 1
    
18.         End If
    
19.     Next i
    
20.     [h2:i100] = ""
    
21.     [h2].Resize(k, 2) = crr
    
22.     MsgBox "OK！"
    
23. End Sub
    

复制代码

x-xx-xx

目标不明确 如果数组2不都被数组1包含呢

GG函数

如需要可在我蓝奏云连接免费下载，永久免费使用