问Excel VBA -查找不匹配行并将其复制到另一个工作表。

EN

Sub SOPractice()
    
    Dim SearchCell As Range 'each value being checked
    Dim SearchRng As Range 'column A
    Dim LastRow As Long
    Dim MatchFound As Range
    Dim i As Long: i = 1
    
    LastRow = YourSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    With YourSheet
        Set SearchRng = .Range(.Cells(2, 1), .Cells(LastRow, 1))
    
    
    Application.ScreenUpdating = False
    
    For Each SearchCell In SearchRng
        Set MatchFound = .Range("D:D").Find _
        (What:=SearchCell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        If MatchFound Is Nothing Then 'No match hence copy to other sheet
            .Range(SearchCell.Address, SearchCell.Offset(, 1)).Copy
            YourCopyToSheet.Cells(i, 1).PasteSpecial xlPasteAll
            i = i + 1
        End If
    
    Next SearchCell
    
    End With

    Application.ScreenUpdating = True
    Application.CutCopyMode = False
        
End Sub

Dim Cl As Range, Rng As Range, Dic As Object

Set Dic = CreateObject("scripting.dictionary")

With Dic
For Each Cl In MyWorksheet1Name.Range("D2", MyWorksheet1Name.Range("D" & Rows.Count).End(xlUp))
    .Item(Cl.Value) = Empty
Next Cl
For Each Cl In MyWorksheet1Name.Range("A2", MyWorksheet1Name.Range("A" & Rows.Count).End(xlUp))
    If Not .Exists(Cl.Value) Then
    If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
    End If
Next Cl
End With

If Not Rng Is Nothing Then
    Rng.EntireRow.Copy MyWorksheet2Name.Range("A" & Rows.Count).End(xlUp)
End If