Puanlamada renklendirme

[kemalist]

Puanlama esnasında isimlerde renklendirme yapmak istiyorum.Dosya ektedir.İlginiz için şimdiden teşekkür ederim.

 

[Murat OSMA]

Bunun için makro şart mı peki?
Koşullu Biçimlendirme ile de yapılabilir.

 

[kemalist]

satır sayısı çok fazla olduğu için makro istedim.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub renklendir()
sonL = Cells(Rows.Count, "L").End(3).Row
sonR = Cells(Rows.Count, "R").End(3).Row
Application.ScreenUpdating = False
    For i = 2 To sonL
        If WorksheetFunction.CountIf(Range("R1:R" & sonR), Cells(i, "L")) > 0 Then
            If WorksheetFunction.VLookup(Cells(i, "L"), Range("R1:S" & sonR), 2, 0) < Cells(i, "M") Then
                Cells(i, "L").Interior.ThemeColor = xlThemeColorAccent6
            ElseIf WorksheetFunction.VLookup(Cells(i, "L"), Range("R1:S" & sonR), 2, 0) > Cells(i, "M") Then
                Cells(i, "L").Interior.Color = vbRed
                Cells(i, "L").Font.Color = vbWhite
            Else
                Cells(i, "L").Interior.Color = vbYellow
            End If
        Else
            Cells(i, "L").Interior.Color = xlNone
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[kemalist]

Çok teşekkür ederim Yusuf Bey

 

[Korhan Ayhan]

Alternatif;

Hız olarak avantaj sağlayabilir.

Option Explicit

Sub Renklendir()
    Dim Dizi As Object, Son As Long, Veri As Variant, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Range("L2:L" & Rows.Count).Interior.Color = xlNone
    Range("L2:L" & Rows.Count).Font.Color = 0
    
    Son = Cells(Rows.Count, "R").End(3).Row
    Veri = Range("R2:S" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 1)) = Veri(X, 2)
    Next
    
    Son = Cells(Rows.Count, "L").End(3).Row
    Veri = Range("L2:M" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        If Dizi.Exists(Veri(X, 1)) Then
            If Veri(X, 2) > Dizi.Item(Veri(X, 1)) Then
                Cells(X + 1, "L").Interior.Color = 9359529
            ElseIf Veri(X, 2) < Dizi.Item(Veri(X, 1)) Then
                Cells(X + 1, "L").Interior.Color = 255
                Cells(X + 1, "L").Font.Color = 16777215
            ElseIf Veri(X, 2) = Dizi.Item(Veri(X, 1)) Then
                Cells(X + 1, "L").Interior.Color = 65535
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[kemalist]

Korhan Hocam çok teşekkürler

 

[Muhammet Okumuş]

Korhan Bey, dizideki değerlere renk uygulanabilyor mu? (Hücreye yazdırmadan)

 

[Korhan Ayhan]

Hücre aralığını diziye alırken değerlerini alıyoruz. Bu değerleri döngü içinde hızlı bir şekilde sorguluyoruz. Dizide renklendirme yapabilmemiz için değere hücre özelliği kazandırmak gerekir. Bu da dizinin mantığına terstir. Klasik For-Each-Next ya da For-Next döngüsü ile hücreler işleme alınarak renk özelliği kullanılabilir. Ama bu durumda veri yoğunluğuna göre biraz yavaşlık söz konusu olacaktır. Ben işin içine dizi yöntemini katarak biraz da olsa hızlandırmaya çalıştım.