用字典模拟Vlookup匹配取数

excel1202

字典入门求助：
字典模拟Vlookup匹配取数求助：用表一中的“姓名+单位”去查找表二中的“姓名+单位”，找到后就把表二中的 D列、E列的金额 分别 加到 表一的 E列、F列中原有的金额中；
表一中找不到的如“刘二、腾讯”就添加到表一A列、B列的最后一行，并把表二中对应的 D列、E列的金额分别填在表一最后一行的 E列、F列中。
数据有几万行，除写入结果外，请用字典+数组的方法。

lizhipei78

比较简单的一题字典+数组题

lizhipei78

用字典模拟Vlookup匹配取数求助.rar (17.34 KB, 下载次数: 29)

2024-8-24 22:38 上传

点击文件名下载附件

excel1202

lizhipei78 发表于 2024-8-24 22:39

需要的是取表二的数,加回到表一中，不是替换掉表一的数，请问如何修改代码，谢谢！

rysxing

试试。。。。。。

taller

醉眼看尘世

1. Sub test()
   
2. Dim Dic(1 To 2) As Object, Arr, i&, j&, tmPstr$, Trr
   
3. For i = 1 To UBound(Dic)
   
4.     Set Dic(i) = CreateObject("scripting.dictionary")
   
5. Next i
   
6. Arr = Sheet2.[a1].CurrentRegion
   
7. For i = 2 To UBound(Arr, 1)
   
8.     tmPstr = Arr(i, 1) & Chr(10) & Arr(i, 2)
   
9.     Dic(1)(tmPstr) = Dic(1)(tmPstr) + Arr(i, 4)
   
10.     Dic(2)(tmPstr) = Dic(1)(tmPstr) + Arr(i, 5)
    
11. Next i
    
12. With Sheet1
    
13.     Arr = .[a1].CurrentRegion
    
14.     For i = 2 To UBound(Arr, 1)
    
15.         tmPstr = Arr(i, 1) & Chr(10) & Arr(i, 2)
    
16.         If Dic(1).exists(tmPstr) Then
    
17.             Arr(i, 5) = Arr(i, 5) + Dic(1)(tmPstr)
    
18.             Arr(i, 6) = Arr(i, 6) + Dic(2)(tmPstr)
    
19.             Dic(1).Remove tmPstr: Dic(2).Remove tmPstr
    
20.         End If
    
21.     Next i
    
22.     .[a1].Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
    
23.    
    
24.     If Dic(1).Count Then
    
25.         '追补新人
    
26.         i = UBound(Arr, 1)
    
27.         For Each d In Dic(1).keys
    
28.             i = i + 1
    
29.             Trr = Split(d, Chr(10))
    
30.             .Cells(i, 1) = Trr(0): .Cells(i, 2) = Trr(1)
    
31.             .Cells(i, 5) = Dic(1)(d): .Cells(i, 6) = Dic(2)(d)
    
32.         Next d
    
33.     End If
    
34. End With
    
35. End Sub
    

复制代码

一招秒杀

Full Join  1句全搞定，唉，比上面的代码简单太多了，简直是不要不要的。

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet2.Range("a1").CurrentRegion.Value
For i = 2 To UBound(arr)
    s = arr(i, 1) & "|" & arr(i, 2)
    dic(s) = Array(arr(i, 3), arr(i, 4))
Next
With Sheet1
    brr = .Range("a1").CurrentRegion.Value
    For j = 2 To UBound(brr)
    ss = brr(j, 1) & "|" & brr(j, 2)
    If dic.exists(ss) Then
        tt = dic(ss)
        brr(j, 4) = tt(0): brr(j, 5) = tt(1)
        dic.Remove ss
    End If
    Next
   
    ReDim crr(1 To UBound(brr), 1 To UBound(brr, 2))
For Each k In dic.keys
    m = m + 1
    k2 = Split(k, "|")
    crr(m, 1) = k2(0): crr(m, 2) = k2(1)
    crr(m, 4) = dic(k)(0): crr(m, 5) = dic(k)(1)
Next
.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
.Range("a" & UBound(brr) + 1).Resize(10000, UBound(brr, 2)).ClearComments
.Range("a" & UBound(brr) + 1).Resize(m, UBound(brr, 2)) = crr
End With
Set dic = Nothing
End Sub

Qs18

试试..............