Çözüldü Benzersizleri Bulma

[hakki83]

Merhaba

Ekteki sürekli kullandığım mükerrerleri bulan kodlar değerli hocamız İbrahim Görgülü hocamıza aittir.

Bunun tam tersini yani Benzersizleri bulacak şekilde kodu düzenleyebilir miyiz?

 

[muygun]

Merhaba;
Kodlarınızı aşağıdaki şekilde revize ederek deneyin.
İyi çalışmalar.

HTML:

İçeriği görebilmek için Giriş yap ya da Üye ol.

 

[İbrahim Görgülü]

Bu şekilde değiştirebilirsiniz.

HTML:

İçeriği görebilmek için Giriş yap ya da Üye ol.

 

[hakki83]

Merhaba;
Kodlarınızı aşağıdaki şekilde revize ederek deneyin.
İyi çalışmalar.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A1000]) Is Nothing Then Exit Sub
For x = 2 To 1000
If WorksheetFunction.CountIf(Range("a2:a" & x), Cells(x, "a")) = 1 Then
Sheets("VERİLER").Cells(x, 1).Interior.Color = 255
Else
Sheets("VERİLER").Cells(x, 1).Interior.Pattern = xlNone
End If
Next
End Sub

Muygun hocam emeğinize sağlık, her bir ismin bir tanesini işaretledi. Ama bu kod da her zaman ihtiyaç olur. Farklı bir kodumuz daha oldu. Teşekkürler.

 

[hakki83]

Bu şekilde değiştirebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A1000]) Is Nothing Then Exit Sub
For x = 2 To 1000
If Application.WorksheetFunction.CountIfs(Range("A2:A1000"), Cells(x, 1)) = 1 Then
Sheets("VERİLER").Cells(x, 1).Interior.Color = 255
Else
Sheets("VERİLER").Cells(x, 1).Interior.Pattern = xlNone
End If
Next

End Sub

İbrahim hocam emeğinize sağlık.

Kaç tane deneme yaptım.
<1 yaptım olmadı

1 olmadı

0 lı yaptım olmadı.
-1
+1
-2
<= yaptım yine olmadı.
=1 yapmak aklıma gelmedi
İşte tecrübe.
Teşekkürler değerli hocamız. Konumuz çözülmüştür.

(Başlığı da yanlış yazmışım, düzeltemedim)

 

[İbrahim Görgülü]

İbrahim hocam emeğinize sağlık.

Kaç tane deneme yaptım.
<1 yaptım olmadı

0 lı yaptım olmadı.
-1
+1
-2
<= yaptım yine olmadı.
=1 yapmak aklıma gelmedi
İşte tecrübe.
Teşekkürler değerli hocamız. Konumuz çözülmüştür.

(Başlığı da yanlış yazmışım, düzeltemedim)

Rica ederim iyi çalışmalar.