ソースシートとデスティネーションシートを比較し、ソースシートの不一致データをコピーする

Question

私は2枚のシートSht1とSht2を持っています。

私はsheet1の列Aとsheet2の列Aを比較しています。両方のシートの列AにIDが含まれています。

sheet2に一致しないIDがある場合は、シート1の一致しない行をコピーします。

私は以下のコードを試してみましたが、問題は、シート2の不一致の最後の行を複数回コピーしていて、Exitなしで実行し続けていることです。

誰でも私がどのように修正できるか教えてください。

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

ここでfindメソッドを使用します。 findメソッドを使用すると、シートS2のIDがシートS1にあるかどうかを調べることができます。

シートS1でIDを検出すると、変数cにID値があります。シートS1でIDが見つからない場合、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 

Answer 3

は、私はちょうどあなたとこのアプローチを共有したい、あなたはしかし、答えを受け入れている知っている：シート1でのIDが等しくない場合、私は、正しくあなたの質問を理解している場合

IDをシート2に入れ、そのシートIDをシート2の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は、あなたが焦点を当てている主なシートであるという事実に基づいて、あなただけの

:)