重複している列が一緒になっている場合は削除する

Question

重複が検出された場合は、行全体を削除しようとしています。一緒に見つからない場合、私はそれを削除せずに保持したい。

For an example Column A: 
Apple, 
Apple, 
Orange, 
Orange, 
Apple, 
Apple, 

出力は次のようにする必要があります。

Apple, 
Orange, 
Apple, 

私は次のコードを使用していますが、まだ希望の出力を得ていません（アップル、オレンジのみ取得）。どんな助けでも感謝しています。

Sub FindDuplicates() 
    Dim LastRow, matchFoundIndex, iCntr As Long 
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 
    For iCntr = 1 To LastRow  
    If Cells(iCntr, 1) <> "" Then 
    matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" &  LastRow), 0) 
    If iCntr <> matchFoundIndex Then 
    Cells(iCntr, 10) = "Duplicate" 
    End If 
    End If 
    Next 

    last = Cells(Rows.Count, "J").End(xlUp).Row ' check results col for values 
    For i = last To 2 Step -1 
    If (Cells(i, "J").Value) = "" Then 
    Else 
    Cells(i, "J").EntireRow.Delete ' if values then delete 
    End If 
    Next i 
    End Sub 

Answer 1

は

Dim LastRow As Long 
Application.screenUpdating=False 
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 
For i = LastRow To 2 Step -1 
    If Cells(i, 1).Value = Cells(i - 1, 1).Value Then 
     Cells(i, 1).EntireRow.Delete 
    End If 
Next i 
Application.screenUpdating=True 

のような単純なものは、これを解決しませんか？

Answer 2

下から上に移動し、上のセルが同じ値である場合にのみ削除します。

dim r as long 

with worksheets("sheet1") 
    for r = .cells(.rows.count, "A").end(xlup).row to 2 step -1 
     if lcase(.cells(r, "A").value2) = lcase(.cells(r - 1, "A").value2) then 
      .rows(r).entirerow.delete 
     end if 
    next r 
end with 

あなたは比較は大文字と小文字を区別しないことにしたくない場合は、lcase機能を削除します。