VBA LOOKKUP求助

yancjm

sheet1表中生产线别依制令号从sheet2中取消数，因VBA不太擅长，在此求助大家，请老师不吝赐教

蓝桥玄霜

如果制令號只对应一个生产线，可以用这个代码。
请见代码。

yancjm

蓝桥玄霜 发表于 2019-1-16 10:13
如果制令號只对应一个生产线，可以用这个代码。
请见代码。

OK了，非常感謝！

yancjm

蓝桥玄霜 发表于 2019-1-16 10:13
如果制令號只对应一个生产线，可以用这个代码。
请见代码。

蓝桥玄霜老师：
能简单注释一下代码吗？我不会举一反三，附件IN,OR,OD三个表想从属性中取分类栏的资料（进口字样），我搞了好久也弄不出来

lsc900707

yancjm 发表于 2019-1-17 13:06
蓝桥玄霜老师：
能简单注释一下代码吗？我不会举一反三，附件IN,OR,OD三个表想从属性中取分 ...

Sub qjk1()
Dim d, arr, i&, myr&, brr, j&
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
myr = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
arr = Sheet2.Range("a2:d" & myr)
For i = 1 To UBound(arr)
     d(arr(i, 1)) = arr(i, 4)
Next
brr = [a3].CurrentRegion
For i = 2 To UBound(brr)
    If d.exists(brr(i, 1)) Then brr(i, 6) = d(brr(i, 1))
Next
[a3].CurrentRegion = brr
Application.ScreenUpdating = True
End Sub

lsc900707

yancjm 发表于 2019-1-17 13:06
蓝桥玄霜老师：
能简单注释一下代码吗？我不会举一反三，附件IN,OR,OD三个表想从属性中取分 ...

1. Sub aaa()
   
2. Dim d, arr, i&, myr&, brr, j&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Application.ScreenUpdating = False
   
5. myr = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
   
6. arr = Sheet2.Range("a2:d" & myr)
   
7. For i = 1 To UBound(arr)
   
8.      d(arr(i, 1)) = arr(i, 4)
   
9. Next
   
10. brr = [a3].CurrentRegion
    
11. For i = 2 To UBound(brr)
    
12.     If d.exists(brr(i, 1)) Then brr(i, 6) = d(brr(i, 1))
    
13. Next
    
14. [a3].CurrentRegion = brr
    
15. Application.ScreenUpdating = True
    
16. End Sub
    
17. Sub bbb()
    
18. Dim d, arr, i&, myr&, brr, j&
    
19. Set d = CreateObject("scripting.dictionary")
    
20. Application.ScreenUpdating = False
    
21. myr = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
    
22. arr = Sheet2.Range("a2:d" & myr)
    
23. For i = 1 To UBound(arr)
    
24.      d(arr(i, 1)) = arr(i, 4)
    
25. Next
    
26. brr = [a5].CurrentRegion
    
27. For i = 2 To UBound(brr)
    
28.     If d.exists(brr(i, 4)) Then brr(i, 10) = d(brr(i, 4))
    
29. Next
    
30. [a5].CurrentRegion = brr
    
31. Application.ScreenUpdating = True
    
32. End Sub
    
33. Sub ccc()
    
34. Dim d, arr, i&, myr&, brr, j&
    
35. Set d = CreateObject("scripting.dictionary")
    
36. Application.ScreenUpdating = False
    
37. myr = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
    
38. arr = Sheet2.Range("a2:d" & myr)
    
39. For i = 1 To UBound(arr)
    
40.      d(arr(i, 1)) = arr(i, 4)
    
41. Next
    
42. brr = [a4].CurrentRegion
    
43. For i = 2 To UBound(brr)
    
44.     If d.exists(brr(i, 4)) Then brr(i, 8) = d(brr(i, 4))
    
45. Next
    
46. [a3].CurrentRegion = brr
    
47. Application.ScreenUpdating = True
    
48. End Sub

复制代码

yancjm

lsc900707 发表于 2019-1-17 14:01
Sub qjk1()
Dim d, arr, i&, myr&, brr, j&
Set d = CreateObject("scripting.dictionary")

代码是OK的，后面还有两个表，以下哪一个代表品号栏位？如果IV表中品号在D栏，需要查询的资料在J栏，以下代码如何修改？
For i = 1 To UBound(arr)
     d(arr(i, 1)) = arr(i, 4)
Next
brr = [a3].CurrentRegion
For i = 2 To UBound(brr)
    If d.exists(brr(i, 1)) Then brr(i, 6) = d(brr(i, 1))

yancjm

lsc900707 发表于 2019-1-17 14:14

看明白了，谢谢！

lsc900707

yancjm 发表于 2019-1-17 14:25
看明白了，谢谢！

测试参考附件：

yancjm

lsc900707 发表于 2019-1-17 14:28
测试参考附件：

已經會了，謝謝！