Excel vba, compare rows of two workbooks and replace

问题

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, Bx filled. Then it copies those in a new workbook.

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)

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 B sheet 1. After the row is found I need to replace workbook's B row with the one from workbook A.

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

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

回答1:

Like I mentioned in my comments, it is possible to use .Find for what you are trying to achieve. The below code sample opens workbooks A and B. It then loops through the values of Col C in Workbook A and 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 B based on what the value is in workbook A. Once the match is found it uses .FindNext for further matches in Col C.

To test this, Save the files that you gave me as C:\A.xls and C:\B.xls respectively. Now open a new workbook and in a module paste this code. The code is comparing Sheet7 of workbook A with Sheet7 of workbook 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

来源：https://stackoverflow.com/questions/11753724/excel-vba-compare-rows-of-two-workbooks-and-replace