两张表按照关键字合并成一张表

850878641

要比较sheet1 和sheet2的不同，按照发票号码把数据合并在sheet3比较。数据量比较大十万行，写循环卡死了

明天会更好zj

这个用power query分分钟搞定

wang-way

明天会更好zj 发表于 2024-9-12 19:32
这个用power query分分钟搞定

望不吝赐教

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.12
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("Sheet1").UsedRange
   
5.     ReDim brr(1 To UBound(arr), 1 To 7)
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 3) & "|" & arr(i, 6)
   
8.         If Not d.exists(s) Then
   
9.             m = m + 1
   
10.             d(s) = m
    
11.             brr(m, 1) = arr(i, 3)
    
12.             brr(m, 2) = arr(i, 6)
    
13.             brr(m, 4) = arr(i, 8)
    
14.             brr(m, 6) = arr(i, 9)
    
15.         Else
    
16.             r = d(s)
    
17.             brr(r, 4) = brr(r, 4) + arr(i, 8)
    
18.             brr(r, 6) = brr(r, 6) + arr(i, 9)
    
19.         End If
    
20.     Next
    
21.     arr = Sheets("Sheet2").UsedRange
    
22.     For i = 2 To UBound(arr)
    
23.         s = arr(i, 3) & "|" & arr(i, 4)
    
24.         If Not d1.exists(s) Then
    
25.             d1(s) = Array(arr(i, 4), arr(i, 5), arr(i, 6))
    
26.         Else
    
27.             t = d1(s)
    
28.             t(1) = t(1) + arr(i, 5)
    
29.             t(2) = t(2) + arr(i, 6)
    
30.             d1(s) = t
    
31.         End If
    
32.     Next
    
33.     With Sheets("Sheet3")
    
34.         .UsedRange.Offset(1).Clear
    
35.         .Columns(1).NumberFormatLocal = "@"
    
36.         .[a2].Resize(m, 7) = brr
    
37.         arr = .UsedRange
    
38.         For i = 2 To UBound(arr)
    
39.             s = arr(i, 1) & "|" & arr(i, 2)
    
40.             If d1.exists(s) Then
    
41.                 arr(i, 3) = d1(s)(0)
    
42.                 arr(i, 5) = d1(s)(1)
    
43.                 arr(i, 7) = d1(s)(2)
    
44.             End If
    
45.         Next
    
46.         .UsedRange = arr
    
47.     End With
    
48.     MsgBox "OK！"
    
49. End Sub
    

复制代码

cnmlgb9998

用PQ 解决。



是这个效果吗？

已去重，每行 的 发票号和品名，都是唯一。

cnmlgb9998

用PQ解决。是这个效果吗？


发票号、品名，每行都是唯一的。 相同的已累加。

cnmlgb9998

怎么老要审核。我又没发代码！ 就截的图！

以前没这个现象的。

cnmlgb9998

发截图，也要经过审核 吗？？？？？？？？？？？？？？？？？？

飞天篮球猪

供参考...