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
私たちは、ループの実行注意ボトムアップを。