Skip to main content

AccessTr.neT


Koşullu Biçimlendirme

Koşullu Biçimlendirme

#19
(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
Cevapla
#20
Önceki kodu deneyin.Olmazsa uzaktan bağlanıp bakabilirim.
Belki reference lerle alakası vardır.
Cevapla
#21
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.
Cevapla
#22
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.
Cevapla
#23
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
Cevapla
#24
teşekkürler hocam olay çözüldü.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task