比較兩個Excel工作簿並將匹配的數據複製到第三個工作簿

Question

我試圖在Excel中比較兩個工作簿並將匹配的列數據複製到新的第三個工作簿的整個行。例：

比較

Workbook_1列A到Workbook_2塔A中，如果有一個名字匹配，複製Workbook_1列的數據相匹配的所述第三工作簿（Workbook_3）的整行。

這是我的代碼：

Sub RunMe() 
Dim lRow, a As Long 

Sheets("Workbook_1").Select 
lRow = Range("A1").End(alDown).Row 

For Each cell In Range("A2:A" & lRow) 
    a = 2 
    Do 
     If cell.Value = Workbook("Workbook_2").Cells(a, "A").Value Then 
      cell.EntireRow.Copy Workbook("Workbook_3").Range("A" & Rows.Count).End(alUp).Offset(1, 0) 
     End If 
     a = a + 1 
    Loop Until IsEmpty(Workbook("Workbook_2").Cells(a, "A")) 
Next 

End Sub 

我發現另一個網站的代碼，我編輯的工作簿的名稱和創建的模塊吧，運行它，但它不工作。

任何幫助將不勝感激，我不擅長excel，所以你可以像你對​​初學者那樣解釋。

謝謝！

Answer 1

你目前的代碼不會做任何接近你想要的。試試下面的代碼，看看它是否適合你。我試着添加一些註釋來解釋代碼在做什麼。確保在代碼中更改工作簿和工作表名稱以匹配您的實際書籍。

Sub RunMe() 

    Dim wbk1 As Workbook, wbk2 As Workbook, wbk3 As Workbook 
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
    Dim lRow1 As Long, lCol1 As Long, lRow3 As Long, x As Long 
    Dim myValue As String 
    Dim Found As Range 

    Set wbk1 = Workbooks("Workbook_1.xlsm") 'Be sure to change these to your actual workbook names 
    Set ws1 = wbk1.Worksheets("Sheet1") 'Be sure to change these to your actual worksheet names 

    Set wbk2 = Workbooks("Workbook_2.xlsm") 
    Set ws2 = wbk2.Worksheets("Sheet1") 

    Set wbk3 = Workbooks("Workbook_3.xlsm") 
    Set ws3 = wbk3.Worksheets("Sheet1") 

    'Using a with block means we don't have to define any range coming from book1. ws1.Range("A2") is the same as .Range("A2") 
    With ws1 
     'Find last row in ws1 Col A 
     lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row 
     'Find last column in ws1 
     lCol1 = .Cells.Find(What:="*", _ 
      After:=.Cells(1, 1), _ 
      LookIn:=xlFormulas, _ 
      LookAt:=xlPart, _ 
      SearchOrder:=xlByColumns, _ 
      SearchDirection:=xlPrevious, _ 
      MatchCase:=False).Column 
     'Start loop to search through all values in column A 
     For x = 2 To lRow1 
      myValue = .Cells(x, 1).Value 
      'Look for value in Workbook2 column A 
      Set Found = ws2.Cells.Find(What:=myValue, _ 
       After:=ws2.Cells(1, 1), _ 
       LookIn:=xlFormulas, _ 
       LookAt:=xlWhole, _ 
       SearchOrder:=xlByRows, _ 
       SearchDirection:=xlPrevious, _ 
       MatchCase:=False) 
      'If Found is not nothing then do something 
      If Not Found Is Nothing Then 
       'Find last row in ws3 Col A 
       lRow3 = ws3.Range("A" & .Rows.Count).End(xlUp).Row 
       'Instead of using .copy saying "This Range = That Range" is much faster 
       ws3.Range(ws3.Cells(lRow3 + 1, 1), ws3.Cells(lRow3 + 1, lCol1)).Value = .Range(.Cells(x, 1), .Cells(x, lCol1)).Value 
      End If 
     Next x 
    End With 

End Sub