Question

我尝试比较excel中的两个工作簿并将匹配的列数据复制到新的第三个工作簿中。例如：

比较

Workbook_1列A到Workbook_2列A，如果名称匹配，则将匹配的Workbook_1列A数据的整行复制到第三个工作簿（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

比较两个Excel工作簿并将匹配的数据复制到第三个工作簿

1 个答案: