56 Koşullu Biçimlendirme

[CAFERCİFTCİ]

Değerli Üstadlar,
Ekli örnekte de görüleceği gibi,aynı çalışma sayfasında iki ayrı sütunda da 56 koşullu biçimlendirme yapmak istiyorum.Ama nasıl?Mutlaka bir bilen üstadımız vardır ve ben onun himmetini bekliyorum...Saygılarımla.

 

[mersilen]

selam
konuyu biraz açar mısın
koşul ne olacak; her sütunda 56 satır ve 56 ayrı renk mi olacak?

 

[m.gur]

Bir ara indirmiştim forumdan. Dosyayı ekliyorum.

 

[CAFERCİFTCİ]

Sorun o değil

Sayın M.Gür,
İlginize teşekkür ederim ama sorumun cevabı o değil.Eklediğiniz dosya bende de var.Bu makro ile bir sütunda renklendirme yapılabiliyot.Örneğin 56 vilayetin hepsi A sütununda farklı renklerde yazdırılabiliyor.Ancak ben aynı sayfanın örneğin D sütununda 56 ayrı kişi ismini de renklendirmek istiyorum.İşte bunu nasıl yaparım,onu öğrenmek istiyorum.İyi geceler...

 

[CAFERCİFTCİ]

İyi geceler

selam
konuyu biraz açar mısın
koşul ne olacak; her sütunda 56 satır ve 56 ayrı renk mi olacak?

n
Sayın Mersilen,
Örneğin A sütununda 56 tane ayrı vilayet ismini renklendirdik.D sütununda da 56 ayrı kişinin ismini renklendireceğiz.K sütununda da 56 adet köy ismini renklendireceğim.Bu sayı artabilir,azalabilir.Bimem anlatabildim mi?Teşekkürler,iyi geceler...

 

[m.gur]

örneğe bakarak eksik kalan yerleri yazmak istediğiniz isimleri yazarak tamamlarsınız. Kolay gelsin.

 

[leumruk]

Merhaba,
Aşağıdaki kodu sayfanızın kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [a1:a65536,d1:d65536]) Is Nothing Then Exit Sub
If Target.Column = 1 Then
deg = Array("", "ADANA", "ADIYAMAN", "AFYON", "AĞRI", "AMASYA", "ANKARA", "ANTALYA", "AYDIN", "BALIKESİR")
ElseIf Target.Column = 4 Then
deg = Array("", "ALİ", "VELİ", "HASAN", "HÜSEYİN", "AHMET", "MEHMET", "KEMAL", "METİN", "BİLAL")
End If
For x = LBound(deg) To UBound(deg)
If deg(x) = Target Then
Target.Interior.ColorIndex = x
Exit For
End If
Next
Son:
End Sub

 

[CAFERCİFTCİ]

Merhaba,
Aşağıdaki kodu sayfanızın kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [a1:a65536,d1:d65536]) Is Nothing Then Exit Sub
If Target.Column = 1 Then
deg = Array("", "ADANA", "ADIYAMAN", "AFYON", "AĞRI", "AMASYA", "ANKARA", "ANTALYA", "AYDIN", "BALIKESİR")
ElseIf Target.Column = 4 Then
deg = Array("", "ALİ", "VELİ", "HASAN", "HÜSEYİN", "AHMET", "MEHMET", "KEMAL", "METİN", "BİLAL")
End If
For x = LBound(deg) To UBound(deg)
If deg(x) = Target Then
Target.Interior.ColorIndex = x
Exit For
End If
Next
Son:
End Sub

Mustafa Hocam merhaba,
Sizi buralarda görmek ne büyük mutluluk,özletmiştiniz kendinizi.Sağlık ve afiyette olmanızı diliyorum.Yardımlarınız için teşekkürler..

 

[CAFERCİFTCİ]

Teşekkürler

örneğe bakarak eksik kalan yerleri yazmak istediğiniz isimleri yazarak tamamlarsınız. Kolay gelsin.

Sayın M.GÜR,
Çok teşekkür ederim...Saygılarımla.

 

[m.gur]

Bişey değil. İyi günler.