两组数据比较

yanglinzi

1. Sub 对比()
   
2. Dim arr, brr, crr, i, j, d, r
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet1.Range("e1").CurrentRegion
   
6. ReDim crr(1 To UBound(arr), 1 To 3)
   
7. For j = 2 To UBound(brr)
   
8.     s = brr(j, 1) & "|" & brr(j, 2)
   
9.     d(s) = d(s) + 1
   
10. Next
    
11. For i = 2 To UBound(arr)
    
12.     s = arr(i, 1) & "|" & arr(i, 2)
    
13.     If Not d.exists(s) Then
    
14.         For j = 1 To 3
    
15.             crr(n, j) = arr(i, j)
    
16.         Next
    
17.     End If
    
18. Next
    
19. Sheet1.[i:i].NumberFormatLocal = "@"
    
20. Sheet1.[i3].Resize(1000, 3).ClearContents
    
21. Sheet1.[i3].Resize(n, 3) = crr
    
22. End Sub
    

复制代码

cai2532

厉害，学习了。

125675117

tanglf188 发表于 2024-3-18 09:45
参与一下

这个更好用，能否增加一个功能，就是如果A和B内容都有，匹配的结果直接为空或者弹个对话框提醒，现在是要报错

cai2532

yanglinzi 发表于 2024-3-18 21:22

是不是漏了累加计数？ n = n + 1

cai2532

无关岁月 发表于 2024-3-18 09:47

程序报错了。

assizx

我用ＰＱ做了一个（见附件：数据源２），若有数据更新，直接在Ａ区或Ｂ区增加数据后，刷新即可。

yanglinzi

cai2532 发表于 2024-3-19 09:48
是不是漏了累加计数？ n = n + 1

是漏了，谢谢提醒