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

Question

这是我想要实现的一些背景。

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

所以我现在所拥有的是：

1. 仅包含其中列A，B已经排满行的工作簿。
2. 包含所有未填充行的工作簿。 （最初的一个）

我现在想要做的是逐行检查，并找到例如在工作簿的乙片1行后工作簿甲的Sheet，减去列A，B，的行1被发现我需要从工作簿甲与所述一个替换工作簿的乙行。

因此，最终我将剩下一个主工作簿（以前的工作簿B），该工作簿将包含已填充行和未填充行。

我希望我不会让这个过于复杂。任何洞察什么是最好的方式来实现这一点，将不胜感激。

Answer 1

就像我在我的评论中提到的那样，您可以使用.Find来实现您的目标。以下代码示例打开工作簿A和B。然后循环遍历工作簿A中的列C的值，并尝试在工作簿B的列C中找到该值的出现次数。如果找到匹配，则比较该行中的所有列。如果所有列都匹配，则根据工作簿中的值A写入工作簿B的列A和列B。一旦找到匹配项，它将使用.FindNext作为ColC的进一步匹配。

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

我相信你现在可以修改它的表

受审的其余部分和测试（在后末见快照）

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 

快照

前

后