makro ile koşula bağlı hücre renklendirme !

[brendie]

Arkadaşlar yapamadım bir türlü. C sabit, K hücrelerini boyamak istiyorum

eğer k2 = 0 ve c2=0 ise k;Interior.ColorIndex = 43 değilse Interior.ColorIndex = xlNone

eğer k2= 0 ve c2=10 ise k;Interior.ColorIndex = 43 değilse Interior.ColorIndex = xlNone

eğer k2= 0 ve c2=20 ise k;Interior.ColorIndex = 43 değilse Interior.ColorIndex = xlNone

eğer k2= 0 ve c2=102 ise k;Interior.ColorIndex = 43 değilse Interior.ColorIndex = xlNone

k3,k4,k5.. diye gidiyo ama şu 4 koşulu makro ile sağlayabilirseniz diğerlerini kendim yapabilirim. K hücreleri dinamik veri aldığı için ve belirli aralıklarla yenilendiği için sanırım koşullu biçimlendirme işe yaramaz. Yardımlarınızı bekliyorum..

 

[brendie]

sanırım biraz zor bi işlem

 

[NBATMAN]

Merhaba,

dosyanızın ile sayfasının kod kısmına aşaşğıdaki kodları yapıştırın. İlgili sayfa içindeki hücrlerde oluşucak değişiklik ile grekli renklenme işlemi olacaktır.


Private Sub Worksheet_Change(ByVal Target As Range)
If Range("k2").Value = 0 And Range("c2").Value = 0 Then
Range("k2").Interior.ColorIndex = 43
Else
Range("k2").Interior.ColorIndex = xlNone
End If
If Range("k2").Value = 0 And Range("c2").Value = 10 Then
Range("k2").Interior.ColorIndex = 43
Else
Range("k2").Interior.ColorIndex = xlNone
End If
If Range("k2").Value = 0 And Range("c20").Value = 0 Then
Range("k2").Interior.ColorIndex = 43
Else
Range("k2").Interior.ColorIndex = xlNone
End If
If Range("k2").Value = 0 And Range("c102").Value = 0 Then
Range("k2").Interior.ColorIndex = 43
Else
Range("k2").Interior.ColorIndex = xlNone
End If
End Sub

 

[gulvadi]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(2, 11).Interior.ColorIndex = xlNone
If Cells(2, 3) = 102 And Cells(2, 11) = 0 Then Cells(2, 11).Interior.ColorIndex = 43
If Cells(2, 3) = 10 And Cells(2, 11) = 0 Then Cells(2, 11).Interior.ColorIndex = 43
If Cells(2, 3) = 20 And Cells(2, 11) = 0 Then Cells(2, 11).Interior.ColorIndex = 43
If Cells(2, 3) = 0 And Cells(2, 11) = 0 Then Cells(2, 11).Interior.ColorIndex = 43
End Sub

 

[brendie]

Arkadaşlar yardımınız için teşekkürler ama çalışmadı. Bu kodları bir modül-buton bağlantısı yapabilirmiyiz acaba? Yani sayfanın kendi veri işlemi bittikten sonra butona basıp renklendirme işlemini yapabilirmiyiz ?

 

[brendie]

Sanırım o zaman makro olarak kaydetmek lazım. Birde bu kodu k2:ah16 aralığına uygulayabilirmiyiz ?

Arkadaşlar yardımınız için teşekkürler ama çalışmadı. Bu kodları bir modül-buton bağlantısı yapabilirmiyiz acaba? Yani sayfanın kendi veri işlemi bittikten sonra butona basıp renklendirme işlemini yapabilirmiyiz ?

 

[NBATMAN]

Merhaba,

verdiğiniz bilgiler neticesinde yapılması gereken işi, yanlış anlamış olma ihtimalime karşı ben size 2 durumlu kod yazdım. Siz uygun olan birini seçersiniz...

İlgili sayfanıza 2 adet commandbutton ekliyerek aşağıda ki kodları kod sayfasına yapıştırınız...

Option Explicit

Private Sub CommandButton1_Click()

Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = xlNone
If Cells(2, "C") = 102 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 10 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 20 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 0 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
End Sub

Private Sub CommandButton2_Click()
Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = xlNone
Dim son As Integer
Dim i As Integer
son = Range("C65536").End(3).Row

For i = 2 To son
If Cells(i, "C") = 102 And Cells(i, "K") = 0 Then Range("K" & i & ":AH" & i).Interior.ColorIndex = 43
If Cells(i, "C") = 10 And Cells(i, "K") = 0 Then Range("K" & i & ":AH" & i).Interior.ColorIndex = 43
If Cells(i, "C") = 20 And Cells(i, "K") = 0 Then Range("K" & i & ":AH" & i).Interior.ColorIndex = 43
If Cells(i, "C") = 0 And Cells(i, "K") = 0 Then Range("K" & i & ":AH" & i).Interior.ColorIndex = 43
Next
End Sub

 

[brendie]

Sayın nbatman çok teşekkür ederim, denedikten sonra sonucu da burada yazacağım. Tekrar çok saolun

 

[brendie]

Sayın Nbatman kod çalışıyor fakat ters olarak. Şöyleki, ben modüle kodları şu şekilde kaydedip,

Option Explicit
Sub Kod2()
Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = xlNone
If Cells(2, "C") = 102 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 10 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 20 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
If Cells(2, "C") = 0 And Cells(2, "K") = 0 Then Range("K" & 2 & ":AH" & 16).Interior.ColorIndex = 43
End Sub

sayfanın kod kısmınada

Private Sub CommandButton1_Click()
Call Kod2
End Sub

Çalıştırdım fakat herhangi bir işlem yapmadı. bende K2: AH16 aralığını kendim boyadım. Kodu çalıştırınca tüm renkli hücreleri renksiz hale getirdi. Kod çalışıyor ama ters durumda sanırım, boyaması gerekirken boyalıları siliyor. Acaba, Range("K" & 2 & ":Z" & 16).Interior.ColorIndex = xlNone kısmından kaynaklı olabilir mi diye düşünüyorum.

Sayın nbatman çok teşekkür ederim, denedikten sonra sonucu da burada yazacağım. Tekrar çok saolun

 

[NBATMAN]

Merhaba

ekteki dosyayı dener misiniz?

 

[brendie]

Sayın Nbatman sanırım ben yanlış anlattım özür dilerim, sadece karşıladığı değere ait hücreyi renklendirmeli, yani;
k2,L2,M2...AH2 deki değer c2 dekini karşılıyorsa sadece k2 renklenmeli
k3,L3,M3...AH3 deki değer c3 dekini karşılıyorsa sadece k3 renklenmeli
k4,L4,M4...AH4 deki değer c4 dekini karşılıyorsa sadece k4 renklenmeli

Bu işlem c2-c16 ve k2-k16 dan...... ah2-ah16 aralığına kadar bu şekilde devam ediyor.Yani k sutunundan başlayıp ah sutununa kadar sadece ilgili hücreler renklenmeli. ( örneğin c3 deki değer L3, M3..vs karşılıyorsa sadece o hücreler renklenmeli)

Merhaba

ekteki dosyayı dener misiniz?

 

[NBATMAN]

Merhaba,

Dosyanız ektedir...

 

[brendie]

Sayın Nbatman emeğinize yüreğinize sağlık gerçekten ne kadar teşekkür etsem azdır, çok saolun harika olmuş

Merhaba,

Dosyanız ektedir...