2つの列を比較、クリア重複細胞

hatman:

私は重複のための2つの列(AおよびB)を比較しようとしています。出力として、私は(ない重複)と一致しない細胞を取得しようとしています。列Aの値が表2コードターゲットから来ている表1及び列Bの値から来ていることは基本的に表2(列B)から削除されたアイテム知るようにすることです。

データは次のようになります。

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

出力は次のようになります。

A           B
BMW
FIAT

これは、重複を強調するために働いているが、値が重複している、削除取得する方法?たとえば、使用して.ClearContentsそして、その後、私は範囲内の空の行を削除するためのループを持っています。

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
ゲイリーの学生:

これを試してみます:

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

私たちは、ループの実行注意ボトムアップを

おすすめ

転載: http://10.200.1.11:23101/article/api/json?id=406722&siteId=1