求助：如何查找提取数据，实现类似VLOOKUP功能

448911031

求助：如何查找提取数据，实现类似VLOOKUP功能
困惑点：如何分别处理一行中的两个条件，两个条件是单独使用。

母件编码	母件名称	子件编码	子件名称	母件计划价	子件计划价
201010001	654-380-01铣磨	201000002	654-380-01毛坯
201010002	654-380-02铣磨	201000003	654-380-02毛坯
201010003	654-335-21铣磨	201000004	654-335-21毛坯
201010004	09D-25铣磨	201000005	09D-25毛坯
201010005	09D-26铣磨	201000006	09D-26毛坯
201010006	09D-29（1.6×目镜片二）铣磨	201000007	09D-29（1.6×目镜片二）毛坯
201010007	09D-30（1.6×目镜片一）铣磨	201000008	09D-30（1.6×目镜片一）毛坯
201010008	09D-40铣磨	201000009	09D-40毛坯
201010009	09D-42铣磨	201000010	09D-42毛坯
201010010	09D-49铣磨	201000011	09D-49毛坯
201010011	09D-50铣磨	201000012	09D-50毛坯
201010012	09C-11铣磨	201000013	09C-11毛坯
201010013	09D-23铣磨	201000014	09D-23毛坯
201010014	09D-24铣磨	201000015	09D-24毛坯

看见星光

计划价表是不是没有符合母件编码的数据呢？

448911031

看见星光 发表于 2015-9-14 15:16
计划价表是不是没有符合母件编码的数据呢？

{:soso_e100:}

不好意思，数据删过头了，已更新，谢谢！

huang1314wei

1. Sub text()
   
2.     Dim arr, brr, i%, j%
   
3.     arr = Sheet4.Range("A1").CurrentRegion
   
4.     brr = Sheet8.Range("A1").CurrentRegion
   
5.     For i = 2 To UBound(brr)
   
6.         For j = 2 To UBound(arr)
   
7.             If brr(i, 1) = arr(j, 1) Then
   
8.                 brr(i, 5) = arr(j, 3)
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     Sheet8.Range("A1").CurrentRegion = brr
    
13. End Sub

复制代码

看见星光

448911031 发表于 2015-9-14 16:15
不好意思，数据删过头了，已更新，谢谢！

1. Sub d()
   
2. Dim d As Object, arr, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("计划价").[a1].CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.     d(arr(i, 1)) = arr(i, 3)
   
7. Next
   
8. With Sheets("BOM表")
   
9.     arr = .Range("a1:f" & Cells(Rows.Count, 1).End(3).Row)
   
10.     For i = 2 To UBound(arr)
    
11.         arr(i, 5) = ""
    
12.         arr(i, 6) = ""
    
13.         If d.exists(arr(i, 1)) Then arr(i, 5) = d(arr(i, 1))
    
14.         If d.exists(arr(i, 3)) Then arr(i, 6) = d(arr(i, 3))
    
15.     Next
    
16.     .Range("a1:f" & Cells(Rows.Count, 1).End(3).Row) = arr
    
17. End With
    
18. Set d = Nothing
    
19. End Sub
    

复制代码

看见星光

附件参考 92.rar (15.61 KB, 下载次数: 66)

2015-9-14 16:54 上传

点击文件名下载附件