根据ID列匹配两个工作簿中的数据，并更新ID匹配的第一个工作簿中两列中的数据

Question

我正在尝试做这样的事情：

工作簿1

   B  R   S
   1  22  41
   2  43  22
   4  55  30
   5  72  0

工作簿2

    B  R  S
    5  13 43 
    3  34 23
    1  20 4
    2  89 90

工作簿1（在宏与B列中的ID匹配并将数据从工作簿2粘贴到R和S列之后更新）

   B   R  S
   1   20 4
   2   89 90 
   4   55 30
   5   13 43

基本上，我正在尝试匹配工作簿的A列中的ID，并在工作簿2的B列和c列中具有匹配ID的行中粘贴任何数据，并将其粘贴到B和C的单元格上在工作簿1中。

这是我根据问题appending data based on condition设法拼凑的代码（感谢提出问题的人和回答问题的人！）

   Sub Update_Worksheet()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LR As Long, ws2LR As Long
Dim i As Long, j As Long, LastCol As Long
Dim ws1Rng As Range, aCell As Range
Dim SearchString

Set ws1 = Sheets("Sheet1")
'~~> Assuming that ID is in Col B
'~~> Get last row in Col B in Sheet1
ws1LR = ws1.Range("B" & Rows.Count).End(xlUp).Row
'~~> Set the Search Range
Set ws1Rng = ws1.Range("B1:B" & ws1LR)

Set ws2 = Sheets("Sheet2")
'~~> Get last row in Col B in Sheet2
ws2LR = ws2.Range("B" & Rows.Count).End(xlUp).Row

'~~> Loop through the range in Sheet 2 to match it with the range in Sheet1
For i = 1 To ws2LR
    SearchString = ws2.Range("B" & i).Value

    '~~> Search for the ID
    Set aCell = ws1Rng.Find(What:=SearchString, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    '~~> If found
    If Not aCell Is Nothing Then
        LastCol = ws2.Cells(i, ws2.Columns.Count).End(xlToLeft).Column

我觉得这是我必须更改的部分，但是不确定如何覆盖它以覆盖我需要用数据覆盖的列：（特别是，如果需要覆盖工作表2的R＆S，则我需要工作表2的R＆S列A列中的ID匹配）

        '~~> Append values
        For j = 2 To LastCol
            ws1.Cells(aCell.Row, j).Value = ws2.Cells(i, j).Value
        Next j
    End If
Next i
End Sub

任何帮助将不胜感激！

Answer 1

您的问题模棱两可，但据我所知，我为您修改了此问题。

'~~> If found
If Not aCell Is Nothing Then
    '~~> Append values
        ws1.Cells(aCell.Row, 2).Value = ws2.Cells(i, 2).Value
        ws1.Cells(aCell.Row, 18).Value = ws2.Cells(i, 18).Value
        ws1.Cells(aCell.Row, 19).Value = ws2.Cells(i, 19).Value
End If