0

这是我要实现的目标的一些背景知识。

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

所以我现在拥有的是：

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

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

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

我希望我没有把这弄得太复杂。任何关于什么是实现这一目标的最佳方法的见解将不胜感激。

4

1 回答 1

1

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

要对此进行测试，请将您给我的文件分别保存为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

快照

前

在此处输入图像描述

后

在此处输入图像描述

于 2012-08-03T09:20:36.307 回答