求助，通过批量循环查找匹配，拿一个表中的号码去匹配另外一个数据表，找出对应数据

frank48

需要达到的效果：

        通过批量循环查找匹配，拿“整理数据”表中的身份证号码去匹配”投保名单“表中的数据，如果在”投保名单“表中能找到数据，就把对应的名字、参保状态、合同号、投保日期、生效日期分别填到“整理数据”表中，如果没有找到该证件号码则在“参保状态”列中填入“没有找到数据”。


单一查找就会，要自动把所有号码分别去查找如何实现？请大神帮忙！

naolew

根据你的要求，用数组结合字典，基本达到目的，请参考！

1. Sub 查询匹配()
   
2. Dim Arr, i&, Myr&, Brr
   
3. Dim d
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Application.ScreenUpdating = False
   
6. Sheets("整理数据").Activate
   
7. Arr = Sheets("投保名单").[a1].CurrentRegion
   
8. For i = 2 To UBound(Arr)
   
9.     d(Arr(i, 3)) = i
   
10. Next
    
11. Myr = Cells(Rows.Count, 1).End(xlUp).Row
    
12. Brr = Range("b1:b" & Myr)
    
13. 
    
14. For i = 2 To UBound(Brr)
    
15.     If d.exists(Brr(i, 1)) Then
    
16.         Cells(i, 3) = Arr(d(Brr(i, 1)), 2)
    
17.         Cells(i, 4) = Arr(d(Brr(i, 1)), 4)
    
18.         Cells(i, 5) = Arr(d(Brr(i, 1)), 5)
    
19.         Cells(i, 6) = Arr(d(Brr(i, 1)), 6)
    
20.         Cells(i, 7) = Arr(d(Brr(i, 1)), 7)
    
21.    
    
22.         Else
    
23.         Cells(i, 4) = "没有参保数据"
    
24.     End If
    
25. Next
    
26. Application.ScreenUpdating = True
    
27. End Sub
    

复制代码

frank48

naolew 发表于 2017-8-14 21:07
根据你的要求，用数组结合字典，基本达到目的，请参考！

感谢指导！！！就是要这样的效果。棒棒的

nakedman

如果这两份表在不同的工作簿该怎么做?请指导一下，谢谢！

nakedman

naolew 你好，部分代码看不懂，能在代码写上注释吗，如果可以非常感谢！

迷者问禅

naolew 发表于 2017-8-14 21:07
根据你的要求，用数组结合字典，基本达到目的，请参考！

大神你好，我有个问题想请教，两张表，sheet2中 E列 值 在sheet1 D列中找到相同值，根据此条件把 sheet1 A 列的值放入 sheet2 B列  如何实现，本人是小白，非常感谢。。

naolew

nakedman 发表于 2017-10-15 01:39
naolew 你好，部分代码看不懂，能在代码写上注释吗，如果可以非常感谢！

数据在两个工作薄的话，部分代码加上路径即可，请上附件，说明需求，有时间帮你看看。

naolew

迷者问禅 发表于 2017-12-1 13:44
大神你好，我有个问题想请教，两张表，sheet2中 E列 值 在sheet1 D列中找到相同值，根据此条件把 sheet1  ...

方便的话，请上附件，以便测试效果。

迷者问禅

naolew 发表于 2017-12-1 15:09
方便的话，请上附件，以便测试效果。