Soru Hücredeki değere göre dolgu

[arwenschild]

Merhaba,
Bir excel tablom var. Combobox ile isim seçip farklı bir sayfada veriyi filtreliyor. Yapmaya çalıştığım şey şu; istenen ve mevcut hücrelerinin altındaki değerlere göre G:J hücrelerini boyayacak. Mesela resimdeki gibi Y2'de istenen 4 ise G10:J10 hücrelerini mavi, mevcut kısmında farklı bir renk boyayacak. Koşullu biçimlendirme kullanmak istemiyorum. Konu hakkında yardımcı olabilir misiniz? örnek dosya

 

[Korhan Ayhan]

İnceleyiniz.

Harici Link (Silinebilir) ; https://we.tl/t-D1sq0uGN88

 

[arwenschild]

Korhan Bey merhaba,
Dosyayı inceledim, aslında tam istediğim şey teşekkürler. Bu işlemi koşullu biçimlendirmeyi (veya formülleri) kullanmadan makro olarak yapıp çalıştırabilir miyiz?

edit: aslında aşağıdaki gibi bir şey yapıp atamasını yaptım, çalıştı. Fakat her combobox seçimi değiştiğinde sayfalar değişip tekrar geliyor. "Sheets("veri").Select" ile alakalı olduğunu düşünüyorum. Bu kodu kullanmadan farklı sayfadan veri almam mümkün müdür?

    Range("E4:H23").Select
    Selection.Clear
    Sheets("veri").Select
    Range("B25").Select
    If [B25] = "1" Then
    Sheets("dbrd").Select
    Range("E4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ElseIf [B25] = "2" Then
    Sheets("dbrd").Select
    Range("E4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else
    Sheets("dbrd").Select
    Range("E4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 11111111
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Renklendir()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Range, Bul As Range
    
    Set S1 = Sheets("veri")
    Set S2 = Sheets("dbrd")
    
    S2.Range("E4:H23").Interior.ColorIndex = xlNone
    
    For Each Veri In S2.Range("C4:C" & S2.Cells(S2.Rows.Count, 3).End(3).Row)
        If Veri.Value <> "" Then
            Set Bul = S1.Range("23:23").Find(Veri.Value, , xlValues, xlWhole)
            If Not Bul Is Nothing Then
                Veri.Cells(1, 3).Resize(, Bul.Cells(3, 1)).Interior.Color = 15652797
                Veri.Cells(2, 3).Resize(, Bul.Cells(3, 2)).Interior.Color = 11892015
            End If
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub