+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Koşullu Biçimlendirme (/konu-kosullu-bicimlendirme--87697.html)
RE: Koşullu Biçimlendirme - enginbeyy - 06/10/2020
(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
RE: Koşullu Biçimlendirme - feraz - 06/10/2020
Önceki kodu deneyin.Olmazsa uzaktan bağlanıp bakabilirim.
Belki reference lerle alakası vardır.
RE: Koşullu Biçimlendirme - enginbeyy - 06/10/2020
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.
RE: Koşullu Biçimlendirme - feraz - 06/10/2020
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.Rica ederim üstad.Hata aranan bulunamazsa verirdi onun için koşul eklemiştim.
Teşekkürler.
Kolay gelsin.Zaman olunca başka yoldan yaparsamda kodu ekleyebilirim.
RE: Koşullu Biçimlendirme - feraz - 06/10/2020
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 SubRE: Koşullu Biçimlendirme - enginbeyy - 07/10/2020
teşekkürler hocam olay çözüldü.