比较表1和表1 2如果不匹配复制行到表3,则使用列B1作为指导

时间:2015-03-20 04:44:54

标签: excel vba excel-vba

我有一张excel,有3张。在表1和表2中,我每个大约有10列,但总行数不同。我想检查工作表2中的数据是否在工作表1中。如果它有匹配,则不执行任何操作,但如果没有匹配则将整行复制到工作表3中。

这是我的代码但我认为我弄错了

Sub test() 
Dim rng As Range, c As Range, cfind As Range 
On Error Resume Next 
Worksheets("sheet3").Cells.Clear 
With Worksheets("sheet1") 
Set rng = Range(.Range("A2"), .Range("a2").End(xlDown)) 
For Each c In rng 
With Worksheets("sheet2") 
Set cfind = .Columns("A:A").Cells.Find _ 
(what:=c.Value, lookat:=xlWhole) 
If cfind Is Nothing Then GoTo line1 
'c.EntireRow.Copy Worksheets("sheet3").Cells(Rows.Count,      "A").End(xlUp).Offset(1, 0) 
c.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
c.Offset(0, 2).Copy Worksheets("sheet3").Cells(Rows.Count,    "B").End(xlUp).Offset(1, 0) 


End With 'sheet 2 
line1: 
Next c 
Application.CutCopyMode = False 
End With 'sheet 1 

如下图所示,请参阅

第1页 enter image description here

第2页 enter image description here

第3页 enter image description here

表3是我的预期输出。我可以获得这样的输出。 请帮忙。

感谢。

1 个答案:

答案 0 :(得分:2)

试试这个"

Sub test()

    Dim rng As Range, c As Range, cfind As Range

    On Error Resume Next

    Worksheets(3).Cells.Clear

    With Worksheets(1)
        Set rng = .Range(.Range("A2"), .Range("a2").End(xlDown)) 'added . (dot) in front of first range
        For Each c In rng
        With Worksheets(2)
            Set cfind = .Columns("A:A").Cells.Find _
            (what:=c.Value, lookat:=xlWhole)
            If cfind Is Nothing Then
                'change the "10" in "Resize(1, 10)" to the number of columns you have
                c.Resize(1, 10).Copy Worksheets(3).Cells(Worksheets(3).Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        End With 'sheet 2
        Next c
        Application.CutCopyMode = False
    End With 'sheet 1

End Sub

编辑Avidan的评论问题

要检查其他工作表上每一行的每一行,需要采用不同的方法。如:

Sub CopyMissingRecords()
'compare whole record in row on 1st worksheet with all records in rows on 2nd worksheet
'and if there is no such row in the 2nd worksheet, then copy the missing record to 3rd worksheet
'repeat for all records on 1st worksheet

    Dim varToCopy() As Variant
    Dim varToCompare() As Variant
    Dim intCopyRow As Integer
    Dim intCopyRowMax As Integer
    Dim intToCompareRow As Integer
    Dim intToCompareRowMax As Integer
    Dim bytColumnsInData As Byte
    Dim intMisMatchCounter As Integer
    Dim intComparingLoop As Integer
    Dim intRowMisMatch As Integer

    bytColumnsInData = 10 ' change to your situation

    'clear everything in our output columns in Worksheets(3)
    With Worksheets(3)
    .Range(.Cells(2, 1), .Cells(.Rows.Count, bytColumnsInData)).Clear
    End With

        With Worksheets(1)
            'last row in Worksheets(1)
            intCopyRowMax = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

            'compare each row in Worksheets(1)
            For intCopyRow = 2 To intCopyRowMax

                'store the first row record from Worksheets(1) into memory
                ReDim varToCopy(0)
                varToCopy(0) = .Range(.Cells(intCopyRow, 1), .Cells(intCopyRow, bytColumnsInData))

                With Worksheets(2)
                    'last row in Worksheets(2)
                    intToCompareRowMax = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

                    'loop through all rows in Worksheets(2)
                    For intToCompareRow = 2 To intToCompareRowMax

                        'store the actual row record from Worksheets(2) into memory
                        ReDim varToCompare(0)
                        varToCompare(0) = .Range(.Cells(intToCompareRow, 1), .Cells(intToCompareRow, bytColumnsInData))

                        'compare each column from the row record in Worksheets(1), with each column from the row record in Worksheets(2)
                        For intComparingLoop = 1 To bytColumnsInData
                            'if any of the cells from Worksheets(1) in compared row are different than cells from Worksheets(2) in compared row
                            'just one difference in row is enough to consider this record as missing
                            If varToCopy(0)(1, intComparingLoop) <> varToCompare(0)(1, intComparingLoop) Then
                                'store how many row MisMatches are there in data
                                intRowMisMatch = intRowMisMatch + 1
                                Exit For
                            End If
                        Next intComparingLoop
                    Next intToCompareRow 'next row in Worksheets(2)


                'if there are as many row mismatches as there are row records in Worksheets(2)
                If intRowMisMatch = intToCompareRowMax - 1 Then
                    With Worksheets(3)
                        'copy the entire row from Worksheets(1) to the next available row in Worksheets(3)
                        Worksheets(1).Range(Worksheets(1).Cells(intCopyRow, 1), Worksheets(1).Cells(intCopyRow, bytColumnsInData)).Copy _
                        Destination:=.Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    End With 'Worksheets(3)
                End If

                'reset the counter
                intRowMisMatch = 0

                End With 'Worksheets(2)

            Next intCopyRow 'next row in Worksheets(1)

        End With 'Worksheets(1)
End Sub