利用字典对两表数据比对增删改的练习题

吴中泉

如题，详见附件 利用字典对两表数据比对增删改.rar (303.67 KB, 下载次数: 30)

2023-6-17 21:41 上传

点击文件名下载附件

吴中泉

1. Sub ssjss() '2023.6.17 wzq
   
2.     Dim ar, i&, r&, dic As Object, T
   
3.     Set dic = CreateObject("Scripting.Dictionary")
   
4.     Set dic1 = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("动态表").[A1].CurrentRegion
   
6.         ar = .Resize(30000)
   
7.         r = .Rows.Count
   
8.         For i = 2 To r
   
9.         dic1(ar(i, 1)) = Array(ar(i, 2), ar(i, 3))
   
10.         Next i
    
11.     End With
    
12.     With Sheets("原始表").[A1].CurrentRegion
    
13.         ar = .Resize(30000)
    
14.         r = .Rows.Count
    
15.         For i = 2 To r: dic(ar(i, 4)) = i: Next i
    
16.     End With
    
17.     For i = 2 To r
    
18.         If dic1.exists(ar(i, 4)) Then
    
19.             If dic1(ar(i, 4))(0) > ar(i, 10) Then
    
20.                 ar(i, 13) = "增加"
    
21.             ElseIf dic1(ar(i, 4))(0) < ar(i, 10) Then
    
22.                 ar(i, 13) = "减少"
    
23.             End If
    
24.             ar(i, 10) = dic1(ar(i, 4))(0)
    
25.             ar(i, 11) = dic1(ar(i, 4))(1)
    
26.         Else
    
27.             ar(i, 13) = "核销"
    
28.         End If
    
29.     Next
    
30.     For Each T In dic1.keys
    
31.         If Not dic.exists(T) Then
    
32.             ar(i, 4) = T
    
33.             ar(i, 10) = dic1(T)(0)
    
34.             ar(i, 11) = dic1(T)(1)
    
35.             ar(i, 13) = "新增"
    
36.             i = i + 1
    
37.         End If
    
38.     Next
    
39.     Sheets("原始表").[A1].Resize(i, UBound(ar, 2)) = ""
    
40.     Sheets("原始表").[A1].Resize(i, UBound(ar, 2)) = ar
    
41.     Set dic = Nothing: Set dic = Nothing
    
42. End Sub
    
43. 
    

复制代码

ykcbf1100

楼主真勤奋啊，为你点赞！

吴中泉

ykcbf1100 发表于 2023-6-17 21:53
楼主真勤奋啊，为你点赞！

谢谢鼓励！
都是今天的练习题，一是交流学习，二是发到论坛里主要是保存一下，方便日后查找和在别的机器上使用。

lizhipei78

字典的经典用法，不嫌麻烦的话，其实加三列辅助列，三个VLOOKUP也是能解决的，还能实时更新，也不用写代码这么麻烦

吴中泉

lizhipei78 发表于 2023-7-1 17:07
字典的经典用法，不嫌麻烦的话，其实加三列辅助列，三个VLOOKUP也是能解决的，还能实时更新，也不用写代码 ...

嗯，好方法，谢谢帮助。