"b" den "j" sütununa kadar mükerrer varsa önceki olanı silsin(satırı silmeden)

[sdegirmenci]

"b" den "j" sütununa kadar mükerrer varsa (satırı silmeden) mükerreri silermi?

Değerli Hocalarım Merhaba;
Ekteki dosyamda aşağıdaki kodu uygulayarak yalnızca "b" sütununda mükerrer varsa mükererin satırını siliyor, Ben "b" sütunundan "j" sütununa kadar mükerrer varsa silmesini istiyorum.Ancak Satır silmeden yalnızca mükerer kaydı silmesi mümkünmü.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For b = [b65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("b1:b" & b), Cells(b, "b")) > 1 Then Rows(b).Delete
Next
End Sub

 

[ersoyalan]

Merhaba,

Kodlarınızı silip aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
sut = Target.Column
If WorksheetFunction.CountIf(Columns(sut), Target) > 1 Then Target.ClearContents
End Sub


E.ALAN

 

[sdegirmenci]

Sayın Ersoylan;
İlginize çok teşekkür ederim. Kodu değiştirdim. Tam istediğim gibi oldu. Bilginize sağlık.Hoşçakalın.

 

[ersoyalan]

Rica ederim

İyi çalışmalar.

E.ALAN