比较源表单和Dest表单，并复制源表单中不匹配的数据

我有两张表格Sht1和Sht2。

我将sheet1的A列与sheet2的A列进行比较。 两个表格的A列都包含ID。

如果sheet2中有不匹配的ID，那么我想复制sheet1中不匹配的行。

我尝试了下面的代码，问题是，它只是复制多次不匹配sheet2的最后一行，并保持不退出运行。

任何人都可以帮助我如何纠正它。

Sub trialtest() Dim srcLastRow As Long, destLastRow As Long Dim srcWS As Worksheet, destWS As Worksheet Dim i As Long, j As Long Application.ScreenUpdating = False Set srcWS = ThisWorkbook.Sheets("S2") Set destWS = ThisWorkbook.Sheets("S1") srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row For i = 5 To destLastRow For j = 5 To srcLastRow If destWS.Cells(i, "A").Value <> srcWS.Cells(j, "A").Value Then destWS.Cells(i, "A") = srcWS.Cells(j, "A") destWS.Cells(i, "B") = srcWS.Cells(j, "B") destWS.Cells(i, "C") = srcWS.Cells(j, "C") destWS.Cells(i, "D") = srcWS.Cells(j, "D") destWS.Cells(i, "E") = srcWS.Cells(j, "E") destWS.Cells(i, "F") = srcWS.Cells(j, "F") destWS.Cells(i, "G") = srcWS.Cells(j, "G") destWS.Cells(i, "H") = srcWS.Cells(j, "H") destWS.Cells(i, "I") = srcWS.Cells(j, "I") destWS.Cells(i, "J") = srcWS.Cells(j, "J") destWS.Cells(i, "K") = srcWS.Cells(j, "K") destWS.Cells(i, "L") = srcWS.Cells(j, "L") destWS.Cells(i, "M") = srcWS.Cells(j, "M") destWS.Cells(i, "N") = srcWS.Cells(j, "N") destWS.Cells(i, "O") = srcWS.Cells(j, "O") destWS.Cells(i, "P") = srcWS.Cells(j, "P") destWS.Cells(i, "Q") = srcWS.Cells(j, "Q") destWS.Cells(i, "R") = srcWS.Cells(j, "R") destWS.Cells(i, "S") = srcWS.Cells(j, "S") End If Next j Next i Application.ScreenUpdating = True End Sub 

Answer 1

试试这个代码

 Sub trialtest() Dim srcLastRow As Long, destLastRow As Long, rowIndex As Long Dim srcWS As Worksheet, destWS As Worksheet Dim i As Long, j As Long Dim found As Boolean Application.ScreenUpdating = False Set srcWS = ThisWorkbook.Sheets("S2") Set destWS = ThisWorkbook.Sheets("S1") srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row rowIndex = destLastRow found = False For i = 5 To srcLastRow For j = 5 To destLastRow 'Debug.Print srcWS.Cells(i, "A").Value & " : " & destWS.Cells(j, "A").Value If srcWS.Cells(i, "A").Value = destWS.Cells(j, "A").Value Then found = True 'rowIndex = rowIndex + 1 'destWS.Cells(rowIndex, "A") = srcWS.Cells(j, "A") Exit For End If Next j If found = False Then rowIndex = rowIndex + 1 'destWS.Cells(rowIndex, "A") = srcWS.Cells(i, "A") destWS.Range("A" & rowIndex & ":S" & rowIndex).Value = srcWS.Range("A" & i & ":S" & i).Value End If found = False Next i Application.ScreenUpdating = True End Sub 

如果有什么不清楚，请告诉我。

Answer 2

我知道你已经接受了答案，但是我只想和你分享这个方法：

如果我正确地理解了你的问题，如果表1中的ID不等于表2中的ID，那么用表2中的IDreplace表1的ID？

 Option Explicit Dim i, n As Long Sub IDReplace() n = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Sheet1") For i = 2 To n If .Cells(i, 1).Value <> .Parent.Sheets("Sheet2").Cells(i, 1).Value Then .Cells(i, 1).Value = .Parent.Sheets("Sheet2").Cells(i, 1).Value End If Next i End With End Sub 

基于表单1是您关注的主要表单的事实，您只需要计算表单1的行数而不是表单2的行数

乐于帮助 ：）

Answer 3

我会用find方法在这里工作。 使用find方法，您可以查看Sheet S2中的ID是否在Sheet S1中。

如果在工作表S1中findID，则variablesc具有ID值。 如果在Sheet S1中没有findID，则c的值为Nothing。 然后代码将从表单S1中复制最后一行的ID列表中的行。

 Sub trialtest() Dim srcLastRow As Long, destLastRow As Long Dim srcWS As Worksheet, destWS As Worksheet Dim i As Long, j As Long Application.ScreenUpdating = False Set srcWS = ThisWorkbook.Sheets("S2") Set destWS = ThisWorkbook.Sheets("S1") srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row With destWS.Range(Cells(5, 1), Cells(destLastRow, 1)) For j = 5 To srcLastRow Set c = .Find(srcWS.Cells(j, "A").Value, LookIn:=xlValues) ' if value not in destWS copy it form srcWS If c Is Nothing Then srcWS.Range("A" & j & ":S" & j).Copy _ Destination:=destWS.Cells(destLastRow + 1, 1) destLastRow = destLastRow + 1 End If Next j End With Application.ScreenUpdating = True End Sub