Ayni Sayilari Belirt

[emre1979]

Arkadaslar Yardimci Olursaniz Sevinirim

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub ayni_olanlar()
Dim hucre1, hucre2 As Range
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("A1:B65536").ClearFormats
For Each hucre1 In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    For Each hucre2 In Range("B1:B" & Cells(65536, "B").End(xlUp).Row)
        If hucre1.Value = hucre2.Value Then
            hucre1.Interior.ColorIndex = 3
            hucre2.Interior.ColorIndex = 3
        End If
    Next
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbInformation
End Sub

 

[emre1979]

Ustad Tesekkurler Eline Saglik

 

[Orion1]

Ustad Tesekkurler Eline Saglik

Rica ederim.
İyi çalışmalar.

 

[baydeniro]

Paylaşım İçin Teşekkürler

Paylaşım için teşekkürler. Sadece A kolonunda olanları işaretlemek için kodu nasıl değiştirmek lazım ?

 

[Orion1]

Paylaşım için teşekkürler. Sadece A kolonunda olanları işaretlemek için kodu nasıl değiştirmek lazım ?

Sadece a sütunundakilerin işaretlenmesi için kodların ilgili yerini aşağıdaki gibi değiştiriniz.

If hucre1.Value = hucre2.Value Then
            hucre1.Interior.ColorIndex = 3
End If

 

[baydeniro]

Sayın Orion2, mevcut kodu sizin yazdığınız kısmı da ekleyerek kodu amatörce aşağıdaki gibi revize ettim. Ancak bu sefer de 1 den fazla olmasa bile hepsini kırmızıya boyuyor. Sadece 1 kereden fazla tekrarlayanları boyatmak için kodu nasıl revize etmeliyim.

Sub ayni_olanlar()
Dim hucre1, hucre2 As Range
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("A1:A65536").ClearFormats
For Each hucre1 In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
For Each hucre2 In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
If hucre1.Value = hucre2.Value Then
hucre1.Interior.ColorIndex = 3
End If
Next
Next
Application.ScreenUpdating = True
MsgBox "Islem Tamamlandi..!!", vbInformation
End Sub

 

[Ali]

Sub tekrarları_renklendir()
For a = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Cells(a, "a").Interior.ColorIndex = 3
Next
End Sub

 

[baydeniro]

Çok Teşekkürler

Sayın Ali, çok çok teşekkürler. Elleriniz dert görmesin.