比较两张纸 - 差异写入纸张3

时间:2014-12-16 06:52:38

标签: excel vba

这是事情: 我有2张表(两者都约10k行) - 我想比较它们 - 如果有匹配(基于B栏 - 什么都不做,如果没有 - 值在sheet2但不在表1中 - 写全部列(A,B,C,D)到sheet3) - 问题是,表1中的第一行可能与sheet2中的第3行相同。

我如何实现这一目标?

是否可以根据B列中的值逐行检查?

由于

1 个答案:

答案 0 :(得分:2)

我创建了一个符合以下条件的工作簿:

Sheet 1中:

Column A  | Column B | Column C |  Column D | Column E
------------------------------------------------------
111024       961207    value1       data a     fake 11
111027       961209    value2       data b     fake 22
111030       961211    value3       data a     fake 33
...
...
...

和表2是表1的副本,但缺少几行。

然后我打开Visual Basic编辑器( Alt + F11 )并添加了一个模块,然后编写了以下宏:

Sub compare()
    Sheets(3).Activate  'Go to sheet 3
    Cells.Clear         'and clear all previous results

    Range("a1").Select  'set cursor at the top

    Sheets(1).Activate  'go to sheet 1
    Range("a1").Select  'begin at the top



    Dim search_for As String   'temp variable to hold what we need to look for
    Dim cnt As Integer         'optional counter to find out how many rows we found

    Do While ActiveCell.Value <> ""   'repeat the follwoing loop until it reaches a blank row

        search_for = ActiveCell.Offset(0, 1).Value   'get a hold of the value in column B

        Sheets(2).Activate  'go to sheet(2)

        On Error Resume Next   'incase what we search for is not found, no errors will stop the macro

        Range("b:b").Find(search_for).Select  'find the value in column B of sheet 2

        If Err <> 0 Then   'If the value was not found, Err will not be zero

            On Error GoTo 0  'clearing the error code

            Sheets(1).Activate   'go back to sheet 1

            r = ActiveCell.Row   'get a hold of current row index

            Range(r & ":" & r).Select  'select the whole row

            cnt = cnt + 1   'increment the counter

            Selection.Copy  'copy current selection

            Sheets(3).Activate  'go to sheet 3

            ActiveCell.PasteSpecial xlPasteAll  'Past the entire row to sheet 3

            ActiveCell.Offset(1, 0).Select  'go down one row to prepare for next row.


        End If
        Sheets(1).Activate   'return to sheet 1
        ActiveCell.Offset(1, 0).Select   'go to the next row

    Loop   'repeat

    Sheets(3).Activate    'go to sheet 3 to examine findings

    MsgBox "I have found " & cnt & " rows that did not exist in sheet 2"

End Sub

然后我运行宏,发现它正在工作..

我希望这个答案可以帮助你实现自己想要的目标。

如果你愿意,here is the Excel workbook I created 在看到代码运行之前,您需要启用宏。 Office将自动警告您包含任何包含宏的Excel文件。