Yinelenen Satırları Silme

[wenes]

Kodlar aşağıda

Sub teke_indir()
Dim i As Long
Sheets("Sayfa1").Select
For i = Cells(65536, "B").End(xlUp).Row To 5 Step -1
    If WorksheetFunction.CountIf(Range("B" & i & ":B4"), Cells(i, "B").Value) > 1 Then
        Range("B" & i).EntireRow.Delete (xlUp)
    End If
Next i
MsgBox "Mükerrer kayıtlar silinmiştir."
End Sub

Hocam merhaba.

Bu kod sorunsuz çalışmakta fakat, mükerrer kayıt aramasını iki sütunu baz alarak yapmak istiyorum. Mesela C ve F sütunu aynı olan satırlar silinsin istiyorum, nasıl yapabiliriz?

 

[Orion1]

Hocam merhaba.

Bu kod sorunsuz çalışmakta fakat, mükerrer kayıt aramasını iki sütunu baz alarak yapmak istiyorum. Mesela C ve F sütunu aynı olan satırlar silinsin istiyorum, nasıl yapabiliriz?

Buyurun.

Sub teke_indir()
Dim i As Long
Sheets("Sayfa1").Select
For i = Cells(65536, "C").End(xlUp).Row To 5 Step -1
    If WorksheetFunction.CountIfs(Range("C" & i & ":C5"), Cells(i, "C").Value, Range("F" & i & ":F5"), Cells(i, "F").Value) > 1 Then
        Range("C" & i).EntireRow.Delete (xlUp)
    End If
Next i
MsgBox "C ve F sütunlarında ,mükerrer kayıtlar silinmiştir."
End Sub

 

[wenes]

Buyurun.

Teşekkürler hocam hızlısınız gerçekten.

 

[Orion1]

Teşekkürler hocam hızlısınız gerçekten.

Rica ederim.
İyi çalışmalar.

 

[zaruri]

Sub teke_indir()
Dim i As Long
Sheets("Sayfa1").Select
For i = Cells(65536, "B").End(xlUp).Row To 5 Step -1
If WorksheetFunction.CountIf(Range("B" & i & ":B4"), Cells(i, "B").Value) > 1 Then
Range("B" & i).EntireRow.Delete (xlUp)
End If
Next i
MsgBox "Mükerrer kayıtlar silinmiştir."
End Sub



"satırları teke indirme" konusunda çok başarılı bir çalışma, fakat hep aynı sütunları çalıştırmıyoruz. farklı sütunları çalıştırmak istediğimizde ise sütun isimlerini makroya girip değiştirmemiz gerekiyor. Bunu basite indirmenin, dışarıdan sütun adını yazıp veya işaretleyip çalıştırmak mümkün mü?