Excel vba，比较两个工作簿的行并替换

Excel vba, compare rows of two workbooks and replace

提问by kokotas

Here is a bit of background on what I'm trying to achieve.

这是我试图实现的目标的一些背景知识。

I have an excel file, which contains 10 sheets and each of the sheets contain many rows of data. This workbook is sent to different people and each one fills in their respective info,only in columns A,B. I have made a vba script which loops through all the filled in workbooks, and checks which rows have cells Ax, Bxfilled. Then it copies those in a new workbook.

我有一个 excel 文件，其中包含 10 个工作表，每个工作表都包含多行数据。这份工作簿发送给不同的人，每个人都填写各自的信息，仅在 A、B 列中。我制作了一个 vba 脚本，它循环遍历所有填充的工作簿，并检查哪些行有单元格Ax，已Bx填充。然后它将这些复制到一个新的工作簿中。

So what I have right now is:

所以我现在拥有的是：

1. A workbook which contains only the rows of which the columns A,B have been filled.
2. A workbook which contains all unfilled rows. (the initial one)

1. 仅包含 A、B 列已填充的行的工作簿。
2. 包含所有未填充行的工作簿。（最初的那个）

What I want to do now is check row by row, and find e.g. Row 1 of sheet1 of workbook A, minus columns A,B, in workbook's Bsheet 1. After the row is found I need to replace workbook's Brow with the one from workbook A.

我现在想要做的是逐行检查，并在工作簿的B表 1 中找到例如工作簿A的 sheet1 的第 1 行，减去 A、B 列。找到该行后，我需要将工作簿的B行替换为来自工作簿A。

So in the end I will be left with one master workbook (previously workbook B) that will contain both filled and unfilled rows.

所以最后我将留下一个主工作簿（以前的工作簿B），其中将包含已填充和未填充的行。

I hope I didn't make this too complicated. Any insight on what is the best way to achieve this would be appreciated.

我希望我没有把这弄得太复杂。任何有关实现这一目标的最佳方法的见解将不胜感激。

回答by Siddharth Rout

Like I mentioned in my comments, it is possible to use .Findfor what you are trying to achieve. The below code sample opens workbooks Aand B. It then loops through the values of Col C in Workbook Aand tries to find the occurrence of that value in Col C of Workbook B. If a match is found then it compares all columns in that row. And if all columns match then it writes to Col A and Col B of workbook Bbased on what the value is in workbook A. Once the match is found it uses .FindNextfor further matches in Col C.

就像我在评论中提到的那样，它可以.Find用于您想要实现的目标。下面的代码示例打开工作簿A和B. 然后循环遍历 Workbook 中 Col C 的值，A并尝试在 Workbook 的 Col C 中找到该值的出现B。如果找到匹配项，则它会比较该行中的所有列。如果所有列匹配，那么将其写入柱A和工作簿的色柱BB基于价值是什么工作簿A。找到匹配项后，它将.FindNext用于 Col C 中的进一步匹配。

To test this, Save the files that you gave me as C:\A.xlsand C:\B.xlsrespectively. Now open a new workbook and in a module paste this code. The code is comparing Sheet7of workbook Awith Sheet7of workbook B

为了测试这个，保存文件，您送给我C:\A.xls和C:\B.xls分别。现在打开一个新工作簿并在模块中粘贴此代码。代码是Sheet7工作簿A与Sheet7工作簿的比较B

I am sure you can now amend it for rest of the sheets

我相信你现在可以修改其余的工作表

TRIED AND TESTED(See Snapshot at end of post)

尝试和测试（见帖子末尾的快照）

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ws1LRow As Long, ws2LRow As Long
    Dim i As Long, j As Long
    Dim ws1LCol As Long, ws2LCol As Long
    Dim aCell As Range, bCell As Range
    Dim SearchString As String
    Dim ExitLoop As Boolean, matchFound As Boolean

    '~~> Open File 1
    Set wb1 = Workbooks.Open("C:\A.xls")
    Set ws1 = wb1.Sheets("sheet7")
    '~~> Get the last Row and Last Column
    With ws1
        ws1LRow = .Range("C" & .Rows.Count).End(xlUp).Row
        ws1LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    '~~> Open File 2
    Set wb2 = Workbooks.Open("C:\B.xls")
    Set ws2 = wb2.Sheets("sheet7")
    '~~> Get the last Row and Last Column
    With ws2
        ws2LRow = .Range("C" & .Rows.Count).End(xlUp).Row
        ws2LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    '~~> Loop Through Cells of Col C in workbook A and try and find it
    '~~> in Col C of workbook 2
    For i = 2 To ws1LRow
        SearchString = ws1.Range("C" & i).Value

        Set aCell = ws2.Columns(3).Find(What:=SearchString, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        ExitLoop = False

        '~~> If match found
        If Not aCell Is Nothing Then
            Set bCell = aCell

            matchFound = True

            '~~> Then compare all columns
            For j = 4 To ws1LCol
                If ws1.Cells(i, j).Value <> ws2.Cells(aCell.Row, j).Value Then
                    matchFound = False
                    Exit For
                End If
            Next

            '~~> If all columns matched then wrtie to Col A/B
            If matchFound = True Then
                ws2.Cells(aCell.Row, 1).Value = ws1.Cells(i, 1).Value
                ws2.Cells(aCell.Row, 2).Value = ws1.Cells(i, 2).Value
            End If

            '~~> Find Next Match
            Do While ExitLoop = False
                Set aCell = ws2.Columns(3).FindNext(After:=aCell)

                '~~> If match found
                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    matchFound = True

                    '~~> Then compare all columns
                    For j = 4 To ws1LCol
                        If ws1.Cells(i, j).Value <> ws2.Cells(aCell.Row, j).Value Then
                            matchFound = False
                            Exit For
                        End If
                    Next

                    '~~> If all columns matched then wrtie to Col A/B
                    If matchFound = True Then
                        ws2.Cells(aCell.Row, 1).Value = ws1.Cells(i, 1).Value
                        ws2.Cells(aCell.Row, 2).Value = ws1.Cells(i, 2).Value
                    End If
                Else
                    ExitLoop = True
                End If
            Loop
        End If
    Next
End Sub

SNAPSHOT

快照

BEFORE

前

AFTER

后