excel vlookup 多个值和工作簿

debugcn 发表于 Dev

AmatureMarco

我知道之前有人问过这个话题，但没有什么能完全涵盖我的需要。所以这里的事情..

我有两本练习册。一个是从另一个程序导出的，该程序显示了工作人员的姓氏、名字、电子邮件以及他们在哪个病房工作。

[工作簿1示例]

第二个是完整的员工列表，它具有相同的详细信息，但还有一个检查列表列。

[Workbook2 示例]

我需要的是一个宏（可能是一个 vlookup），它从工作簿 1 中获取信息，检查工作簿 2 上的姓氏、名字和病房以确保它是正确的工作人员，将电子邮件复制到工作簿 2 并填写工作簿 2 上的清单列到“是”。

恐怕我不知道如何将所有这些结合在一起。请帮忙。

到目前为止，这是我所拥有的，但我的知识有限，不知道如何进行。

Private Sub UpdateTraining_Click()

Dim I As Integer
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Wb As Workbook
Dim CopyData As String
Dim RwCnt As Long
Dim RwCnt2 As Long
Dim Rw As Long
Dim Clm As Long
Dim SName As String
Dim FName As String
Dim Wrd As String
Dim vArr
Dim ClmLet As String

Set Ws1 = Workbooks("Nursing Docs Training Record.xlsm").Worksheets("Staff Training Record")
Set Ws2 = Workbooks("Nursing Docs Training Record.xlsm").Worksheets("Do Not Use")

Workbooks.Open ("C:\TypeformNursingDocumentation.xlsx")
Set Ws3 = Workbooks("TypeformNursingDocumentation.xlsx").Worksheets("tWeXNp")

RwCnt = Ws3.Cells(Rows.Count, 1).End(xlUp).Row
RwCnt2 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row

Rw = Ws3.Range("F2").Row
Clm = Ws3.Range("F2").Column

Table1 = Ws3.Range("F2:F" & RwCnt)

vArr = Split(Cells(1, Clm).Address(True, False), "$")
ClmLet = vArr(0)

For Each cl In Table1
    Ws3.Range(ClmLet & Rw).Select

    SName = ActiveCell.Value
    FName = ActiveCell.Offset(0, -1).Value
    Wrd = ActiveCell.Offset(0, -4).Value    
    Rw = Rw + 1

Next cl
End Sub

扎克

您可以使用公式来实现这一点，但随后您必须打开Workbook1公式才能在Workbook2. 所以下面的方法使用VBA来实现结果

将以下 UDF 复制到模块中Workbook2：

Sub UpdateMyList()
    Dim oSourceWB As Workbook
    Dim oSourceR As Variant
    Dim iTotSRows&, iTotCRows&, iCC&, iSC&
    Dim oCurR As Variant

    Application.ScreenUpdating = False

    ' First lets get source data
    Set oSourceWB = Workbooks.Open("C:\Temp\EmpLookup.xlsx", ReadOnly:=True)    ' Change the source file name

    With oSourceWB.Worksheets("Sheet1")                                         ' Change the source sheet name
        iTotSRows = .Range("A" & .Rows.count).End(xlUp).Row
        oSourceR = .Range("A2:G" & iTotSRows)
    End With
    oSourceWB.Close False

    ' We now need the data from the sheet in this workbook to compare against
    With ThisWorkbook.Worksheets("Sheet8")                                      ' Change the sheet name to the sheet in your workbook
        iTotCRows = .Range("A" & .Rows.count).End(xlUp).Row
        oCurR = .Range("A2:H" & iTotCRows)
    End With

    ' Next, lets compare and update fields
    For iCC = 1 To UBound(oCurR)
        For iSC = 1 To UBound(oSourceR)
            If (oCurR(iCC, 1) = oSourceR(iSC, 6)) And (oCurR(iCC, 2) = oSourceR(iSC, 5)) And (oCurR(iCC, 5) = oSourceR(iSC, 2)) Then
                oCurR(iCC, 7) = oSourceR(iSC, 7)
                oCurR(iCC, 8) = "Yes"
                Exit For
            End If
        Next
    Next

    Application.ScreenUpdating = True

    ' Finally, lets update the sheet
    ThisWorkbook.Worksheets("Sheet8").Range("A2:H" & iTotCRows) = oCurR

End Sub

我已经评论了您需要更改对工作簿或工作表的引用的行。只要您更新了工作簿和工作表引用，这应该会给您所需的结果