Comparar dos columnas, células duplicados claros

hombre del sombrero :

Estoy tratando de comparar dos columnas (A y B) para los duplicados. Como una salida que estoy tratando de obtener células que no coincide (no duplicados). A valores de columna son procedentes de la tabla 1 y los valores de la columna B están viniendo de la tabla 2. Código de destino es básicamente para conocer qué elementos se elimina de la tabla 2 (columna B).

Los datos se parece a:

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

La salida debe ser:

A           B
BMW
FIAT

Esto está trabajando para poner de relieve los duplicados, pero cómo conseguir valores borrados que son duplicados? Por ejemplo, usando .ClearContents. Luego, después de que tengo bucle para eliminar filas vacías en el rango.

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

Estudiante de Gary:

Probar esto:

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

Tenga en cuenta que corremos los bucles arriba abajo .