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

我有一个有3张纸的excel。 在表1和2中，我大约有10列，但有不同的总行数。 我想检查Sheet 2中的数据是否在Sheet 1中。如果它有一个匹配，则什么都不做，但是如果它没有匹配，那么将整个行复制到Sheet 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

工作表2

表3

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

谢谢。

Answer 1

试试这个“

 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