koşullu biçimlendirme

[bursacem]

Sayın Üstadlar;

ekli dosyada ran.detay çalışma sayfasında bulunan veriye göre sayfa 1 de renklendirme yapabilir miyim?

Örneğin; rand.detay çalışma sayfasında 1 Nisanda da H004 numaralı tezgah 87 randıman yapmış,bu veri sayfa 1 çalışma sayfasında ilgili yere yeşil olarak gelebilir mi?

yani veri yoksa ve randıman 50 den düşükse kırmızı;50-80 arası ise sarı ve 80 den yukarı ise yeşil olabilir mi?

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[bursacem]

Hocam çok teşekkürler. Fakat çok uzun sürüyor
daha hızlı yolu yok mu?

 

[bursacem]

hocam ayrıca 10 dakika oldu hala işlem devam ediyor

 

[muygun]

Merhaba;
Birde bu eki deneyin.
(Her iki tablonun aynı formatta olmaması zorunlu döngüleri gerektiriyor.)
İyi çalışmalar.

 

[bursacem]

hocam süper olmuş.Fakat veri olmayan hücrelerde kırmızı olabilirmi

 

[muygun]

Merhaba;
Dosyanız ekte.
İnceleyin.
İyi çalışmalar.

 

[Korhan Ayhan]

Alternatif kod;

Sub AKTAR_RENKLENDİR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Satir As Long, Sutun As Integer, X As Long
    
    Application.ScreenUpdating = 0
    Application.Calculation = 0
        
    Set S1 = Sheets("rand.detay")
    Set S2 = Sheets("Sayfa1")
    
    Satir = S2.Cells(S2.Rows.Count, 1).End(3).Row
    Sutun = S2.Cells(1, S2.Columns.Count).End(1).Column
    
    S2.Range("B2:" & S2.Cells(Satir, Sutun).Address(0, 0)).ClearContents
    S2.Range("B2:" & S2.Cells(Satir, Sutun).Address(0, 0)).Interior.ColorIndex = xlNone
    
    For X = 2 To Satir
        S2.Range("B" & X & ":" & S2.Cells(X, Sutun).Address(0, 0)) = "=IFERROR(INDEX(" & S1.Name & "!$A:$AF," & "MATCH(" & S2.Cells(X, 1).Address(0, 1) & "," & S1.Name & "!$A:$A" & ",0),MATCH(" & S2.Cells(1, 2).Address(1, 0) & "," & S1.Name & "!$1:$1" & ",0)),"""")"
        S2.Range("B" & X & ":" & S2.Cells(X, Sutun).Address(0, 0)).Value = S2.Range("B" & X & ":" & S2.Cells(X, Sutun).Address(0, 0)).Value
        For Y = 2 To Sutun
            Select Case S2.Cells(X, Y)
                Case Is < 50
                    S2.Cells(X, Y).Interior.ColorIndex = 3
                Case 50 To 80
                    S2.Cells(X, Y).Interior.ColorIndex = 6
                Case Is > 80
                    S2.Cells(X, Y).Interior.ColorIndex = 4
            End Select
        Next
    Next

    Set S1 = Nothing
    Set S2 = Nothing

    Application.ScreenUpdating = 1
    Application.Calculation = 1

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[bursacem]

hocam çok tesekkurler

 

[bursacem]

Korhan Hocam süper olmuş. Allah razı olsun.

 

[bursacem]

hocam çok teşekkürler sorunsuz çalışıyor