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 

快照

前

後