[已解决]字典查找

z4214488

如附件
表H中数据写入字典，在字典key中查找表K中A1单元格的值，在B1中显示找到的item值


T.zip (30.5 KB, 下载次数: 8)

2017-3-16 10:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

望帝春心

2017-3-16 10:51

1. Sub test()
   
2.     Dim arr, i&
   
3.     arr = Worksheets("H").[A1].CurrentRegion
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         dic(arr(i, 1)) = arr(i, 2)
   
7.     Next
   
8.     Worksheets("K").[b1] = dic(Worksheets("K").[A1].Value)
   
9. End Sub

复制代码

跳转到最佳答案楼层

ilovelittle

按照你的描述是不是可以理解为vlookup就可以满足你的要求了。

Excel学徒123

1. Sub SearCh()
   
2.     Dim objdic As Object
   
3.     Dim arrSrc
   
4.     Dim Ends&, lrow&
   
5.     With Worksheets("H")
   
6.         Ends = .Cells(.Rows.Count, 1).End(3).Row
   
7.         arrSrc = .Range("A1:b" & Ends).Value
   
8.     End With
   
9.     Set objdic = CreateObject("scripting.dictionary")
   
10.     For lrow = 1 To Ends
    
11.         objdic(arrSrc(lrow, 1)) = arrSrc(lrow, 2)
    
12.     Next
    
13.     Worksheets("K").Range("b1") = objdic(Worksheets("K").Range("a1").Value)               
    
14. End Sub
    

复制代码

望帝春心

1. Sub test()
   
2.     Dim arr, i&
   
3.     arr = Worksheets("H").[A1].CurrentRegion
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         dic(arr(i, 1)) = arr(i, 2)
   
7.     Next
   
8.     Worksheets("K").[b1] = dic(Worksheets("K").[A1].Value)
   
9. End Sub

复制代码

望帝春心

1. 参考附件

复制代码