比较两个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