VBA 实现vlookup

chxjchen

各位老师, 求教了
附件中有个"NJG_库存记录&BOM整理 - 副本.xlsm" 的文件, 是多个产品bom的汇总表(压缩包里我只放了3个), 我想把里面的vlookup公式,全部用vba替代.减少公式,提高EXCL的打开速度

zpy2

建议使用数据库sql语言开发，速度会快一些
https://club.excelhome.net/forum.php?mod=viewthread&tid=1662985&pid=11255085&page=1&extra=&mobile=2#pid11255085

ykcbf1100

表名和文件名要搞成一样才行，因为有的文件表有多个并不固定在一个位置。

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.30
   
2.     Set sh = ThisWorkbook.Sheets("mrp")
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Application.ScreenUpdating = False
   
6.     p = ThisWorkbook.Path & ""
   
7.     On Error Resume Next
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If f.Name Like "*.xls*" Then
   
10.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
11.                 fn = fso.GetBaseName(f)
    
12.                 Set wb = Workbooks.Open(f, 0)
    
13.                 With wb.Sheets(fn)
    
14.                     c = Application.WorksheetFunction.Match("Part number", .Rows(1), 0)
    
15.                     c1 = Application.WorksheetFunction.Match("Quantity", .Rows(1), 0)
    
16.                     arr = .UsedRange
    
17.                     wb.Close False
    
18.                 End With
    
19.                 For i = 2 To UBound(arr)
    
20.                     s = arr(i, c) & "|" & fn
    
21.                     d(s) = arr(i, c1)
    
22.                 Next
    
23.             End If
    
24.         End If
    
25.     Next f
    
26.     With sh
    
27.         r = .Cells(Rows.Count, 3).End(3).Row
    
28.         For i = 4 To r
    
29.             For j = 10 To 12
    
30.                 s = .Cells(i, 3) & "|" & .Cells(3, j)
    
31.                 If d.exists(s) Then
    
32.                     .Cells(i, j) = d(s)
    
33.                 Else
    
34.                     .Cells(i, j) = ""
    
35.                 End If
    
36.             Next
    
37.         Next
    
38.     End With
    
39.     Set d = Nothing
    
40.     Application.ScreenUpdating = True
    
41.     MsgBox "OK！"
    
42. End Sub
    

复制代码

chxjchen

ykcbf1100 发表于 2024-3-30 16:08
表名和文件名要搞成一样才行，因为有的文件表有多个并不固定在一个位置。

附件供参考。。。

非常感谢, 我先学习下, 谢谢!

chxjchen

ykcbf1100 发表于 2024-3-30 16:09
参与一下。。。

感谢老师, 试用成功