Koşullu Biçimlendirme

(06/10/2020, 10:28)feraz yazdı: Sayfa adları aynımı koddakilerle?

evet aynı zaten bu gönderdiğiniz dosyanın içine kendi verilerimi yapıştırdım

Önceki kodu deneyin.Olmazsa uzaktan bağlanıp bakabilirim.
Belki reference lerle alakası vardır.

Hocam önceki kod çok uzun sürdü en sonunda ben iptal ettim. Ama ikinci kodda bu defa biçim boyacısıyla her iki sekmeyi benzettim ondan mıdır bilimiyorum ama oldu bu defa.
Teşekkürler.

Son kodu alttaki ile değiştirip deneyin birde.
Önceki kod gibi hızlı olmaz.
Bende hepsi çalışıyor.

Sub renklendir()



    Dim son As Long, i As Long, k As Byte, kacinci As Long

    Dim syfteyit As Worksheet

    Dim syfAnaSayfa As Worksheet

    

    Set syfteyit = ThisWorkbook.Sheets("Teyit")

    Set syfAnaSayfa = ThisWorkbook.Sheets("Anatablo")

    With syfteyit

        son = .Range("A" & Rows.Count).End(3).Row

        If son < 2 Then son = 2

        .Range("A2:R" & son).Interior.ColorIndex = xlNone

        Application.ScreenUpdating = False

        For i = 2 To son

            If WorksheetFunction.CountIf(syfAnaSayfa.Range("A:A"), .Cells(i, 1).Value) > 0 Then

                kacinci = WorksheetFunction.Match(.Cells(i, 1).Value, syfAnaSayfa.Range("A:A"), 0)

                For k = 2 To 18

                    If .Cells(i, k).Value <> syfAnaSayfa.Cells(kacinci, k) Then .Cells(i, k).Interior.ColorIndex = 3

                Next

            End If

        Next

        Application.ScreenUpdating = True

    End With

    Set syfteyit = Nothing

    Set syfAnaSayfa = Nothing



End Sub

---

(06/10/2020, 10:58)enginbeyy yazdı: Hocam önceki kod çok uzun sürdü en sonunda ben iptal ettim. Ama ikinci kodda bu defa biçim boyacısıyla her iki sekmeyi benzettim ondan mıdır bilimiyorum ama oldu bu defa.
Teşekkürler.

Rica ederim üstad.Hata aranan bulunamazsa verirdi onun için koşul eklemiştim.

Kolay gelsin.Zaman olunca başka yoldan yaparsamda kodu ekleyebilirim.

Buda diziler ve Dictionary ile yapılmış hali.
Sanırım hız olayında pek farketmedi son kod ile karşılaştırmada.
Kolay gelsin.

Sub renklendir()



    Dim son As Long, i As Long, k As Byte

    Dim syfteyit As Worksheet, dict As Object, dizi(), dizi2()

    Dim syfAnaSayfa As Worksheet

    

    Set syfteyit = ThisWorkbook.Sheets("Teyit")

    Set syfAnaSayfa = ThisWorkbook.Sheets("Anatablo")

    Set dict = CreateObject("Scripting.Dictionary")

    

    With syfteyit

        son = .Range("A" & Rows.Count).End(3).Row

        If son < 2 Then son = 2

        dizi = syfAnaSayfa.Range("A2:R" & son).Value

        dizi2 = .Range("A2:R" & son).Value

        .Range("A2:R" & son).Interior.ColorIndex = xlNone

        Application.ScreenUpdating = False

        For i = 1 To UBound(dizi)

            dict.Add dizi(i, 1), i

        Next



        For i = 1 To UBound(dizi)

            If dict.Exists(dizi2(i, 1)) Then

                For k = 2 To UBound(dizi, 2)

                    If dizi2(i, k) <> dizi(dict(dizi2(i, 1)), k) Then .Cells(i + 1, k).Interior.ColorIndex = 3

                Next

            End If

        Next

        Application.ScreenUpdating = True

    End With

    Set syfteyit = Nothing

    Set syfAnaSayfa = Nothing

    Erase dizi: Erase dizi2

    Set dict = Nothing



End Sub

teşekkürler hocam olay çözüldü.