Bir satırdaki belli bir sütundaki hücrenin renk dolgusuna göre hücre renklendirme

[u.L.a.s]

Merhaba

Elimdeki çalışma sayfasında bir if döngüsü kurmak istiyorum

şöyleki J,K,L sütunlarımda bazı hücrelerde dolgu rengi mevcur bazılarında ise dolgu rengi yok

örneğin J sütunuda J1 den J5 e kadar dolgu rengi yok J6,J7 hücresinde dolgu rengi var J8,j9,j10 dolgu rengi yok j11 dolgu rengi var gibi random bir şekilde dolgu renk durumu vardır.

eğer dolgu rengi yoksa A sütunundaki karşılığındaki hücredede dolgu rengi olmasın eger dolgu rengi varsa a sütunundaki denk düşen satırdaki hücrede sarı renk dolgulu hücre oluşsun.

Yani J1 den J5 e kadar dolgu rengi yoktu dolayısıyla A1-A5 arası hücrelerde dolgu rengi olmayacak, J6,J7 dolgu rengi var bu yüzden A6,A7 dolgu rengi sarı renk olacak

Bunun aynısını K sütununa bakarakta yapacak L sütununa bakarakta yapacak.

Örneğin J1 J5 arası dolgu rengi yoktu A1-A5 arası dolgu rengi olmayacak fakat K3 dolgu rengi varsa A3 te dolgu rengi oluşmuş olacak. ama L3 te dolgu rengi olmayabilir bu yüzden gidip A3 her halükarda J,K,L sütunlarında ki herhangi bir tanesinde dolgulu hücre olduğu için sarı rengi almış olacak.

Örnek görünüm

 

[u.L.a.s]

sorumu daha basit haliyle anlatayım.

J,K,L sütunlarında bulunan hücrelerde 3 üde fill blank ise A sütununda karşılık gelen satırdaki hücre fill blank kalacak değilse zaten A sütunundaki hücre sarı renk ile boyanacak

 

[Beyribey]

Hocam bi alttaki kodu denermisin ?

Sub Makro1()
Dim i As Integer
Dim Pattern1, pattern2, pattern3 As Integer

For i = 2 To 40

Pattern1 = ActiveSheet.Cells(i, 10).Interior.Pattern
pattern2 = ActiveSheet.Cells(i, 11).Interior.Pattern
pattern3 = ActiveSheet.Cells(i, 12).Interior.Pattern

If Pattern1 = 1 Then
  Cells(i, 10).Copy
  Cells(i, 1).PasteSpecial (xlPasteFormats)

ElseIf pattern2 = 1 Then
  Cells(i, 11).Copy
  Cells(i, 1).PasteSpecial (xlPasteFormats)

ElseIf pattern3 = 1 Then
  Cells(i, 12).Copy
  Cells(i, 1).PasteSpecial (xlPasteFormats)
  
End If
Next

End Sub

 

[Beyribey]

Gerçi sadece sarı istiyorsun, düzelteyim.

If Pattern1 = 1 Or pattern2 = 1 Or pattern3 = 1 Then
Cells(i, 1).Interior.Color = vbYellow
End If

 

[u.L.a.s]

Tamam bu kodla oluyor fakat şöyle bir durum var

ben J,K,L sütunlarındaki renkli hücreleri şartlı koşula bağlı olarak renkelndiriyorum

onuda şu şekilde yapıyorum tarihe göre geçen hafta tarihlerini sarı renk yap diyorum mesela bununda makro düzeneğini şu şekilde sağladım

aşağıdaki kodda kırmızı renkli color =65535 sarı renk dolgu hücresi yapıyor.

sonrasında sizin kodu çalıştırdığımda A sütunundaki hücreler sarı renk olmuyor. eğer manuel renklendirmişsem sizin kod çalışıyor

 Columns("J:L").Select
    Selection.FormatConditions.Add Type:=xlTimePeriod, DateOperator:=xlLastWeek
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
       [B][COLOR="Red"] .Color = 65535[/COLOR][/B]
        .TintAndShade = 0

 

[Ömer BARAN]

Merhaba.

J, K ve L sütununlarındaki koşullu biçimlendirme için uyguladığınız koşulu bilemiyoruz.
Pratik olanı, A sütunu için de J,K ve L sütunu için kullandığınız koşulu kullanarak koşullu biçimlendirme uygulamak gibi görünüyor.

İlk bakışta gördüğüm J, K ve L sütunlarında hep 10'uncu AYa ait tarih içeren hücreler renklendirilmiş.
Eğer J, K ve L sütunları için kullandığınız koşul AY ise;
A1'den itibaren A sütunundaki ilgili alanın tümünü seçin, koşullu biçimlendirme için aşağıdaki formülü uygulayın ve sarı rengi seçerek işlemi onylayın.

=VE(A[B][COLOR="Red"]1[/COLOR][/B]<>"";YADA(VE(J[B][COLOR="red"]1[/COLOR][/B]<>"";AY(J[B][COLOR="red"]1[/COLOR][/B])=[B][COLOR="blue"]10[/COLOR][/B]);VE(K[B][COLOR="red"]1[/COLOR][/B]<>"";AY(K[B][COLOR="red"]1[/COLOR][/B])=[B][COLOR="blue"]10[/COLOR][/B]);VE(L[B][COLOR="red"]1[/COLOR][/B]<>"";AY(L[B][COLOR="red"]1[/COLOR][/B])=[B][COLOR="blue"]10[/COLOR][/B])))

Sorunuzu ekran görüntüsü yerine gerçek belgenizle aynı yapıda örnek belge üzerinden sorarsanız iyi olur.

Ben dahil cevap yazanlar, cevabın ekran görüntüsünü vermiyor,
çözüme ulaşmanız için, üşenmeden boş belge üzerinden denemeler yaparak ulaştığı sonucu uzun uzun anlatıyor değil mi?

Örnek belge ekleyerek destek isterseniz, konuyla ilgilenen üyeler de gereksiz yere soru-cevap/yeni soru-yeni cevap
ile uğraşmaz ve başka üyelerin destek ricalarıyla ilgilenme zamanı bulabilirler.

Yukarıda belirttiğim şekilde sorunu çözemezseniz ya örnek belge yükleyin ya da aşağıdaki kod'u deneyin.
.

Sub kosullu_renk()
For brn = [B][COLOR="Red"]1[/COLOR][/B] To 40
Cells(brn, 1).Interior.Color = xlNone
    If Cells(brn, "J").DisplayFormat.Interior.ColorIndex <> -4142 Or _
        Cells(brn, "K").DisplayFormat.Interior.ColorIndex <> -4142 Or _
        Cells(brn, "L").DisplayFormat.Interior.ColorIndex <> -4142 Then _
        Cells(brn, 1).Interior.Color = vbYellow
Next
End Sub

Sonradan eklenen not:
Hafta olayını yeni fark ettim, yukarıda verdiğim formülde AY(...)=10 yerine HAFTASAY(...)+1=HAFTASAY(BUGÜN())
şeklinde değişiklik yapmak gerekiyor.

.

 

[u.L.a.s]

Ömer Bey Emeğinize bilginize sağlık çok teşekkür ederim. makro kod işimi gördü.

ayrıca her konuda detaylı anlatımlarınız içinde çok teşekkür ediyorum

Beyribey sizede çok teşekkür ediyorum bilgi ve yardımlarınızı için