用字典方法代替Vlookup

erwen

想在库存数据导入这张表中通过“第一条码”这列，在产品资料表中查询货号与尺码，显示在库存数据库导入，如何用字典的方法多列显示结果，因为产品资料上万行，用vlookup太慢了，求老师指导 货品条码模板.zip (29.7 KB, 下载次数: 56)

2018-7-19 11:39 上传

点击文件名下载附件

CC例例

供测试

1. Sub Tset()
   
2.     Dim d As Object, arA, arB, i&, x&
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arA = Sheets("产品资料").Range("a1").CurrentRegion
   
5.     arB = Range("a1").CurrentRegion
   
6.     For i = 2 To UBound(arB)
   
7.         d(arB(i, 2)) = i
   
8.     Next
   
9.     For i = 2 To UBound(arA)
   
10.         If d.Exists(arA(i, 1)) Then
    
11.             arB(d(arA(i, 1)), 7) = arA(i, 2)
    
12.             arB(d(arA(i, 1)), 8) = arA(i, 3)
    
13.         End If
    
14.     Next
    
15.     Range("a1").CurrentRegion = arB
    
16. End Sub

复制代码

liulang0808

1. Sub 按钮1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Application.ScreenUpdating = False
   
4.     brr = ActiveSheet.UsedRange
   
5.     arr = Sheets("产品资料").UsedRange
   
6.     For j = 2 To UBound(brr)
   
7.         d(brr(j, 2)) = j
   
8.     Next j
   
9.     For j = 2 To UBound(arr)
   
10.         If d.exists(arr(j, 1)) Then
    
11.             brr(d(arr(j, 1)), 7) = arr(j, 2)
    
12.             brr(d(arr(j, 1)), 8) = arr(j, 3)
    
13.         End If
    
14.     Next j
    
15.     ActiveSheet.UsedRange = brr
    
16.     Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

CC例例

附件供参考

erwen

CC例例 发表于 2018-7-19 11:59
供测试

感谢大大，再麻烦问下如果没有找到显示“”空值，我加了
        Else
            arB(d(arA(i, 1)), 7) = ""
            arB(d(arA(i, 1)), 8) = ""，报错是我写法错了吗

erwen

liulang0808 发表于 2018-7-19 12:00
附件内容供参考。。。。。。

感谢老师，再麻烦问下如果没有找到显示“”空值，我加了
        Else
            arB(d(arA(i, 1)), 7) = ""
            arB(d(arA(i, 1)), 8) = ""，报错是我写法错了吗

CC例例

erwen 发表于 2018-7-19 12:59
感谢大大，再麻烦问下如果没有找到显示“”空值，我加了
        Else
            arB(d(arA(i, 1)),  ...

1. Sub Tset()
   
2.     Dim d As Object, arA, arB, i&, x&
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arA = Sheets("产品资料").Range("a1").CurrentRegion
   
5.     arB = Range("a1").CurrentRegion
   
6.     For i = 2 To UBound(arB)
   
7.         d(arB(i, 2)) = i
   
8.         arB(i, 7) = ""
   
9.         arB(i, 8) = ""
   
10.     Next
    
11.     For i = 2 To UBound(arA)
    
12.         If d.Exists(arA(i, 1)) Then
    
13.             arB(d(arA(i, 1)), 7) = arA(i, 2)
    
14.             arB(d(arA(i, 1)), 8) = arA(i, 3)
    
15.         End If
    
16.     Next
    
17.     Range("a1").CurrentRegion = arB
    
18. End Sub

复制代码

jiminyanyan

这种帖子挺多的。。。。

liulang0808

erwen 发表于 2018-7-19 13:45
感谢老师，再麻烦问下如果没有找到显示“”空值，我加了
        Else
            arB(d(arA(i, 1)) ...

不存在，本来就是空的吧？
而且楼主的没有找到就是字典不包含相应键值，目前楼主这种用法有点画蛇添足了
直接赋值为空即可