求助应用

1643688477

如何根据工作薄A的E列和D列某一行的两个单元格的值来匹配工作薄B的G列和D列，从而在工作薄A的F列得到工作薄B的B列值呢？

quqiyuan

这个用公式方便点，供参考
=INDEX([B.xlsx]Sheet1!$B:$B,MATCH(E2&D2,[B.xlsx]Sheet1!$G:$G&[B.xlsx]Sheet1!$D:$D,))

windshc

=XLOOKUP(D2&E2,[B.xlsx]Sheet1!$D:$D&[B.xlsx]Sheet1!$G:$G,[B.xlsx]Sheet1!$C:$C)

Qs18

试一下......

Qs18

Sub test()
Application.ScreenUpdating = False
Dim arr, brr, dic As Object, i, j, wb As Workbook, xwb As Workbook
Set wb = Workbooks.Open(ThisWorkbook.Path & "\B.xlsx", 0)
Set dic = CreateObject("scripting.dictionary")
arr = wb.Sheets(1).Range("a1").CurrentRegion.Value
wb.Close
For i = 2 To UBound(arr)
  If Len(arr(i, 4)) > 0 Then
        s = arr(i, 4) & arr(i, 7)
        dic(s) = arr(i, 2)
  End If
Next
brr = Sheet1.Range("a1").CurrentRegion.Value
For j = 2 To UBound(brr)
        s = brr(j, 4) & brr(j, 5)
        brr(j, 6) = dic(s)
Next
Sheet1.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
Set dic = Nothing
Set wb = Nothing
MsgBox "完成！"
Application.ScreenUpdating = True
End Sub

1643688477

quqiyuan 发表于 2024-6-12 22:13
这个用公式方便点，供参考
=INDEX(Sheet1!$B:$B,MATCH(E2&D2,Sheet1!$G:$G&Sheet1!$D:$D,))

用vlookup 多条件也可以啊，三键结束。 只是想用字典把它弄出来。

1643688477

windshc 发表于 2024-6-12 22:24
=XLOOKUP(D2&E2,Sheet1!$D:$D&Sheet1!$G:$G,Sheet1!$C:$C)

xlookup函数要分版本才行的。

Qs18

测试一下......

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, dic As Object, strJoin$, strFileName$, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "B.xlsx"
    If Dir(strFileName) = "" Then MsgBox "B文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With GetObject(strFileName)
        ar = .Worksheets(1).[A1].CurrentRegion.Value
        For i = 2 To UBound(ar)
            strJoin = ar(i, 4) & ar(i, 7)
            dic(strJoin) = ar(i, 2)
        Next i
        .Close False
    End With
   
    ar = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        strJoin = ar(i, 4) & ar(i, 5)
        ar(i, 6) = dic(strJoin)
    Next i
    [A1].CurrentRegion.Value = ar
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。。