VBA 如何用字典和数组代替vlookup

smile121212

smile121212 发表于 2019-6-18 09:35
请问为什么要先写这句？
[F2:L10000] = Empty

已经明白了，谢谢~

lsc900707

两表字段名统一的话也可以这样多列匹配：

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         For j = 2 To UBound(arr, 2)
   
6.             s = arr(i, 1) & arr(1, j)
   
7.             d(s) = arr(i, j)
   
8.         Next
   
9.     Next
   
10.     brr = [a1].CurrentRegion
    
11.     For i = 2 To UBound(brr)
    
12.         For j = 6 To UBound(brr, 2)
    
13.             s = brr(i, 2) & brr(1, j)
    
14.             brr(i, j) = d(s)
    
15.         Next
    
16.     Next
    
17.     [a1].CurrentRegion = brr
    
18. End Sub

复制代码

lsc900707

测试参考附件：

毛利的乖乖熊

写了一段如下,可以达到你的目的

Sub 查询()
Dim i, j, k, l, lastrow
Dim a As String
Dim arr1()
Set d = CreateObject("scripting.dictionary")
ThisWorkbook.Sheets("数据源").Activate
arr1() = Range("A1:E10")
For i = 2 To UBound(arr1())
  For j = 2 To UBound(arr1(), 2)
     d(arr1(i, 1) & arr1(1, j)) = arr1(i, j)
  Next j
Next i
ThisWorkbook.Sheets("匹配后的数据").Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For k = 2 To lastrow
   For l = 6 To lastcol
      If d.exists(Cells(k, 2) & Cells(1, l)) Then Cells(k, l) = d(Cells(k, 2) & Cells(1, l))
   Next l
Next k

End Sub

excelhomesnake

python代码，数据源的列位置可以随意调整，目标表的物料列可以随意调整，最后4列的位置可以随意调整。

1. import xlwings as xw
   
2. import pandas as pd
   
3. 
   
4. wb=xw.books['如何用字典及数组来代替Vlookup.xlsm']
   
5. wrk_des=wb.sheets['匹配后的数据']
   
6. 
   
7. df_source=wb.sheets['数据源'].range('a1').current_region.options(pd.DataFrame).value
   
8. df_des=wrk_des.range('a1').current_region.options(pd.DataFrame).value
   
9. # 结果列，按目标表的后4个字段位置
   
10. res_cols=[f'{c}_y' for c in df_des.columns[-4:]]
    
11. # 左连接，用物料列为key
    
12. res_df=df_des.merge(df_source,how='left',on='物料')[res_cols]
    
13. # 回写结果到excel
    
14. wrk_des.range('f2').value=res_df.values

复制代码