Excel VBA，比較兩個工作簿的行並替換

Question

這是我要實現的目標的一些背景知識。

我有一個Excel文件，其中包含10張工作表，每張工作表都包含多行數據。 將此工作簿發送給不同的人，每個人僅在A，B列中填寫各自的信息。 我制作了一個vba腳本，該腳本循環遍歷所有填充的工作簿，並檢查哪些行具有填充的Ax ， Bx單元格。 然后將其復制到新的工作簿中。

所以我現在所擁有的是：

1. 一個工作簿，僅包含已填充A，B列的行。
2. 包含所有未填寫的行的工作簿。 （最初的）

我現在想做的是逐行檢查，然后在工作簿的B表1中找到工作簿A的sheet1的第1行，減去列A，B。找到行之后，我需要用一個替換工作簿的B行從工作簿A。

因此，最后我將獲得一個主工作簿（以前是工作簿B ），其中既包含填充行也包含未填充行。

我希望我不要太復雜。 任何關於什么是實現這一目標的最佳方法的見解將不勝感激。

Answer 1

就像我在評論中提到的那樣，可以使用.Find作為您要實現的目標。 下面的代碼示例打開工作簿A和B 然后，它遍歷工作簿A中Col C的值，並嘗試查找工作簿B中Col C中該值的出現。 如果找到匹配項，它將比較該行中的所有列。 並且，如果所有列都匹配，則根據工作簿A的值將其寫入工作簿B的Col A和Col B中。 找到匹配項后，它將在Col C中使用.FindNext進行進一步的匹配。

要對此進行測試，請將您給我的文件分別保存為C:\\A.xls和C:\\B.xls 。 現在打開一個新的工作簿，並在模塊中粘貼此代碼。 該代碼是比較Sheet7工作簿的A與Sheet7工作簿的B

我確定您現在可以將其修改為其余的工作表

嘗試並測試 （請參閱帖子結尾的快照）

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

快照

之前

后