Hücre Karşılaştırmasına Göre Kod İle Dolgu Rengi Belirleme

[betoncu]

1- C55 VE D55 HÜCRELERİNİN DOLU VE C56,C57,C58, D56, D57, D58 HÜCRELERİNİN HEPSİ BOŞ OLUNCA:

C25 HÜCRESİNİN 45 RENK KODUNDA, H25 HÜCRESİNİN DE 15 RENK KODUNDA BOYANMASINI İSTİYORUM.

2- C56 VE D56 HÜCRELERİNİN DOLU VE C55, C57, C58, D55, D57, D58 HÜCRELERİNİN HEPSİ BOŞ OLUNCA:

C25 HÜCRESİNİN 36 RENK KODUNDA, H25 HÜCRESİNİN DE 43 RENK KODUNDA BOYANMASINI İSTİYORUM.

3- C57 VE D57 HÜCRELERİNİN DOLU VE C55, C56, C58, D55, D56, D58 HÜCRELERİNİN HEPSİ BOŞ OLUNCA:

C25 HÜCRESİNİN 8 RENK KODUNDA, H25 HÜCRESİNİN 45 RENK KODUNDA BOYANMASINI İSTİYORUM.

4- C58 VE D58 HÜCRELERİNİN DOLU VE C55, C56, C57, D55, D56, D58 HÜCRELERİNİN HEPSİ BOŞ OLUNCA:

C25 HÜCRESİNİN 38 RENK KODUNDA, H25 HÜCRESİNİN 39 RENK KODUNDA BOYANMASINI İSTİYORUM.

5- YUKARIDA BELİRTİLEN ŞARTLARIN DIŞINDA C25 VE H25 HÜCRELERİNİN DOLGU RENGİNİN 2 RENK KODUNDA OLMASINI İSTİYORUM.


BU ŞARTLARA UYGUN SAYFADA KULLANABİLECEĞİM VBA KODUNA İHTİYACIM VARDIR. YARDIMLARINIZI BEKLİYORUM...

Örnek dosya ektedir.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()

Range("c25").Interior.ColorIndex = 2
Range("h25").Interior.ColorIndex = 2

If Range("c55") <> "" And Range("D55") <> "" And _
Range("c56") = "" And Range("c57") = "" And Range("c58") = "" And _
Range("d56") = "" And Range("d57") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 45
Range("h25").Interior.ColorIndex = 15

ElseIf Range("c56") <> "" And Range("d56") <> "" And _
Range("c55") = "" And Range("c57") = "" And Range("c58") = "" And _
Range("d55") = "" And Range("d57") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 36
Range("h25").Interior.ColorIndex = 43

ElseIf Range("c57") <> "" And Range("d57") <> "" And _
Range("c55") = "" And Range("c56") = "" And Range("c58") = "" And _
Range("d55") = "" And Range("d56") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 8
Range("h25").Interior.ColorIndex = 45

ElseIf Range("c58") <> "" And Range("d58") <> "" And _
Range("c55") = "" And Range("c56") = "" And Range("c57") = "" And _
Range("d55") = "" And Range("d56") = "" And Range("d57") = "" Then
Range("c25").Interior.ColorIndex = 38
Range("h25").Interior.ColorIndex = 39

End If
End Sub

. . .

 

[Korhan Ayhan]

Merhaba,

Forum kuralları;

Büyük Harf Kısıtlaması:
- Mesaj yazarken büyük harf kullanmak bağırmak anlamına geleceği için yazılarınızı kesinlikle büyük harf kullanarak yazmayınız.

 

[betoncu]

Korhan Bey bundan sonra yazılarımı küçük harf ile yazmaya dikkat edeceğim.

Hüseyin Bey kodu uyguladım fakat olmadı. Örnek dosya ekleyebilirmisiniz?
Birde: Private Sub Worksheet_Change(ByVal Target As Range) olarak yani sayfada kendiliğinden kodun aktif olmasını nasıl sağlarız?

 

[betoncu]

Bu kodu çalıştırınca "End Sub" kısmında hata veriyor.

 

[Emir Hüseyin Çoban]

Korhan Bey bundan sonra yazılarımı küçük harf ile yazmaya dikkat edeceğim.

Hüseyin Bey kodu uyguladım fakat olmadı. Örnek dosya ekleyebilirmisiniz?
Birde: Private Sub Worksheet_Change(ByVal Target As Range) olarak yani sayfada kendiliğinden kodun aktif olmasını nasıl sağlarız?

. . .

Buna benzer forumda bir çok soru ve çözüm var.
Biraz araştırma ile yapabilirsiniz.

. . .

 

[betoncu]

Teşekkür ederim. Sub olarak yapabildim. Private Sub Worksheet_Change(ByVal Target As Range) olarak da yapmaya çalışacağım.
Sizin kodlar olmasa yinede çözemezdim. Tekrar teşekkür ederim...

 

[betoncu]

Faydası olması bakımından kodu ekliyorum:
Sub KOD()

Range("c25").Interior.ColorIndex = 2
Range("h25").Interior.ColorIndex = 2

If Range("c55") <> "" And Range("D55") <> "" And _
Range("c56") = "" And Range("c57") = "" And Range("c58") = "" And _
Range("d56") = "" And Range("d57") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 45
Range("h25").Interior.ColorIndex = 15
Else: GoTo Koşul2
End If
GoTo Sonlandır


Koşul2:

If Range("c56") <> "" And Range("d56") <> "" And _
Range("c55") = "" And Range("c57") = "" And Range("c58") = "" And _
Range("d55") = "" And Range("d57") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 36
Range("h25").Interior.ColorIndex = 43

Else: GoTo Koşul3
End If
GoTo Sonlandır

Koşul3:

If Range("c57") <> "" And Range("d57") <> "" And _
Range("c55") = "" And Range("c56") = "" And Range("c58") = "" And _
Range("d55") = "" And Range("d56") = "" And Range("d58") = "" Then
Range("c25").Interior.ColorIndex = 8
Range("h25").Interior.ColorIndex = 45

Else: GoTo Koşul4
End If
GoTo Sonlandır

Koşul4:

If Range("c58") <> "" And Range("d58") <> "" And _
Range("c55") = "" And Range("c56") = "" And Range("c57") = "" And _
Range("d55") = "" And Range("d56") = "" And Range("d57") = "" Then
Range("c25").Interior.ColorIndex = 38
Range("h25").Interior.ColorIndex = 39

Else
Range("C25").Interior.ColorIndex = xlNone
Range("H25").Interior.ColorIndex = xlNone
End If

Sonlandır:

End Sub