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

Question

这里有一些关于我正在努力实现的背景。

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

所以我现在拥有的是：

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

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

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

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

Answer 1

就像我在我的 cmets 中提到的，可以使用 .Find 来实现您想要实现的目标。下面的代码示例打开工作簿A 和B。然后，它遍历 Workbook A 中 Col C 的值，并尝试在 Workbook B 的 Col C 中查找该值的出现。如果找到匹配项，则会比较该行中的所有列。如果所有列都匹配，则它会根据工作簿A 中的值写入工作簿B 的Col A 和Col B。找到匹配后，它会使用 .FindNext 在 Col C 中进行进一步匹配。

要对此进行测试，请将您提供给我的文件分别保存为 C:\A.xls 和 C:\B.xls。现在打开一个新工作簿并在一个模块中粘贴此代码。代码将工作簿A 的Sheet7 与工作簿B 的Sheet7 进行比较

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

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

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

快照

之前

之后