Excel vba，比较两个工作簿的行并替换 [英] Excel vba, compare rows of two workbooks and replace

问题描述

这是一个有关我正在努力实现的背景。

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

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

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.

所以我现在所在的是：

1. 只包含一个工作簿列A，B的行已被填充。


2. 包含所有未填充行的工作簿。 （最初的一个）

我现在要做的是逐行检查，并找到例如。在工作簿 A 中的工作簿 A 的第1行，减去工作簿 B 工作表中的列A，B。找到行后，我需要替换工作簿的 B 行与工作簿中的一个 A 。

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.

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

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.

推荐答案

像我在评论中提到的，使用 .Find 为您想要实现的目标。以下代码示例打开工作簿 A 和 B 。然后在Workbook A 中循环查看Col C的值，并尝试在工作簿的Col C中找到该值的出现 B 。如果找到匹配项，则比较该行中的所有列。如果所有列匹配，那么根据工作簿中的值 A B 的Col A和Col B C>。一旦匹配被发现，它使用 .FindNext 在Col C进一步的匹配。

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.

要测试这个，保存C：\A.xls 和 C：\B.xls 分别给我的文件。现在打开一个新的工作簿，并在一个模块中粘贴此代码。代码正在将 Sheet7 的工作簿 A 与 Sheet7 工作簿 B

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

我相信您现在可以修改其余的表格

TRIED&TESTED （请参阅帖子结尾的快照）

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

这篇关于Excel vba，比较两个工作簿的行并替换的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！