用字典替代VLOOKUP查找匹配

missd

之前用vlookup计算量太大导致经常死机，请高手帮忙用字典的方法匹配表中sheet表“清单”的C列和sheet表“大表起保”的C列，如匹配上就在“清单”的H列显示“已续保”。

lenghonghai601

1. Sub test()
   
2. Dim d As Object, arr, brr, crr(), i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion: brr = Sheet2.Range("a1").CurrentRegion
   
5. ReDim crr(1 To UBound(arr))
   
6. For i = 2 To UBound(brr)
   
7.     d(brr(i, 3)) = ""
   
8. Next i
   
9. For i = 2 To UBound(arr)
   
10.     If d.exists(arr(i, 3)) Then
    
11.         crr(i - 1) = "已续保"
    
12.     Else
    
13.         crr(i - 1) = "未续保"
    
14.     End If
    
15. Next i
    
16. Sheet1.Range("h2").Resize(UBound(arr) - 1, 1) = WorksheetFunction.Transpose(crr)
    
17. End Sub

复制代码

ahnyt

看看是不是这个意思，符合就送花。

missd

ahnyt 发表于 2018-7-6 10:19
看看是不是这个意思，符合就送花。

多谢，已解决！

missd

lenghonghai601 发表于 2018-7-6 10:11

完美解决，感谢！

missd

lenghonghai601 发表于 2018-7-6 10:11

请问大神：如果sheet1的匹配项变成了I列，sheet2的匹配项不变，最终结果需在R列显示，那么这组代码该如何修改呢？