Comparer deux colonnes, les cellules en double claires

l'homme au chapeau :

Je suis en train de comparer deux colonnes (A et B) pour les doublons. En sortie, je suis en train d'obtenir des cellules qui ne correspondent pas (pas de dupliquer). Colonne des valeurs A proviennent du tableau 1 et les valeurs de la colonne B sont à venir dans le tableau 2. code cible est essentiellement d'apprendre à connaître quels éléments ont été supprimés du tableau 2 (colonne B).

Les données ressemble à:

A           B
BMW         PORSCHE
FIAT        VOLVO
VOLVO       AUDI
PORSCHE     FERRARI
FERRARI     TOYOTA
TOYOTA
AUDI 

La production devrait être:

A           B
BMW
FIAT

Cela fonctionne pour mettre en évidence les doublons, mais comment obtenir des valeurs supprimées qui sont des doublons? Par exemple à l' aide .ClearContents. Puis , après que je boucle pour supprimer des lignes vides dans la plage.

Sub MarkDuplicatesInCompare()

    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastCell As Range
    Dim EntireRow As Range

    Set ws = ThisWorkbook.Sheets("Compare")
    Set myrng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, "B").End(xlUp))
    With myrng
        Set lastCell = .Cells(.Cells.Count)
    End With

    myrng.Interior.ColorIndex = xlNone

    clr = 3

    For Each cell In myrng
        If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then

            If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then

                cell.Interior.ColorIndex = clr
                clr = clr
            Else

                cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
            End If
        End If
    Next

    ' Delete empty rows

    For I = myrng.Rows.Count To 1 Step -1
        Set EntireRow = myrng.Cells(I, 1).EntireRow
        If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
            EntireRow.Delete
        End If
    Next

End Sub

Étudiant de Gary:

Donnez à ce essayer:

Sub Keanup()
    Dim i As Long, j As Long, Na As Long, Nb As Long
    Na = Cells(Rows.Count, "A").End(xlUp).Row
    Nb = Cells(Rows.Count, "B").End(xlUp).Row

    For i = Na To 1 Step -1
        v = Cells(i, "A").Value
        For j = Nb To 1 Step -1
            If v = Cells(j, "B").Value Then
                Cells(i, "A").Delete shift:=xlUp
                Cells(j, "B").Delete shift:=xlUp
                Exit For
            End If
        Next j
    Next i
End Sub

Notez que nous courons les boucles en bas .