BİLGİ DEĞİŞİNCE HÜCRE RENGİ DEĞİŞSİN

[redje]

BÝLGÝ DEÐÝÞÝNCE HÜCRE RENGÝ DEÐÝÞSÝN

MERHABALAR

RENKLENDİRMEM İLE BİRÇOKÃ?RNEK İNCELEDİM FAKAT BENİM İSTEDİÐİM TARZDA BULAMADIM

DÜÞEYARA FORMÜLÜNDEKİ BİLGİ DEÐİÞİNCE O HÜCRENİNDE RENGİ DEÐİÞSİN İSTİYORUM

MERAK ETTİÐİM FORMÜLLEDE BU İÞLEM YAPILABİLİRMİ

Ã?RNEK İÇİNDE DAHA GENİÞ AÇIKLADIM

YARDIMLARININZ İÇİN ÞİMDİDEN TEÞEKKÜR EDER
İYİ ÇALIÞMALAR DİLERİM

 

[Levent Menteşoğlu]

Aşağıdaki kodu sayfa1 in kod sayfasına kopyalayarak deneyin.

[vb:1:a8c3358c17]Dim c, d
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Range("B11:C18").Select
Selection.Interior.ColorIndex = Int(Mid(Target, 3, 2) / 2)
Target.Select
End If
If Target.Address = "$B$5" Then
Range("D11:E18").Select
Selection.Interior.ColorIndex = [b5] * 2
Target.Select
End If
If d <> [b9] Then
c = c + 1
[g15].Interior.ColorIndex = c
d = [b9]
End If
End Sub
[/vb:1:a8c3358c17]

 

[redje]

sayın leventm yardımların için teşekkür derim
birde öğrenmek istediğim formulle bu işlem yapılabilirmi
yardımcı olursanız sevinirim

 

[Levent Menteşoğlu]

Koşullu biçimlendirme kullanılabilir fakat bu durumda sadece 3 renge kadar işlem yapabilirsiniz.

 

[redje]

SAYIN LEVNTM
YAZMIÞ OLDUÐUN MAKROYU YENİ DENEME ÞANSIM OLDU
İÞ GÃ?RÜYOR FAKAT YAZDIÐIM SİCİLLER 4000 E KADAR DEÐİÞİK SİCİLLER OLDUÐUNDANMI ARADA BİR RENK (Selection.Interior.ColorIndex = [b5] * 2 ) BU SATIRDA HATAMESAJI VERİYOR

BİRDE SİYAHA ÇOK DENK GELİYOR BOYUYOR YAZILAR GÃ?RÜNMÜYOR O NEDENLE ÇOK KULLANIÞLI OLMADI RENK SINIRI KOYARAK BELİRLİ RENKLERİ KULLANARAK YADA KOÞULLU BİÇİMLENDİRMEYİ Ã?RNEK ÜZERİNDE YAPMAN MÜMKÜNMÜ YARDIMLARIN İÇİN TEÞEKKÜRLER

 

[redje]

GÜNAYDIN LEVENTM HOCAM YARDIMCI OLURSANIZ SEVİNİRİM

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:0a628a6c54]Dim e, f
Private Sub Worksheet_Change(ByVal Target As Range)
on error resume next
If Target.Address = "$B$2" Then
c = c + 1
Range("B11:C18").Select
Selection.Interior.ColorIndex = c + 2
Target.Select
End If
If Target.Address = "$B$5" Then
d = d + 1
Range("D11:E18").Select
Selection.Interior.ColorIndex = d + 2
Target.Select
End If
If e <> [b9] Then
f = f + 1
[g15].Interior.ColorIndex = f
e = [b9]
End If
End Sub
[/vb:1:0a628a6c54]

 

[redje]

merhaba leventm

uygulamayı yaptım denedim hata mesajı almadım ama b2 ve b5 e sicilleri yazıp enterlediğimde renk değişimi olmadı

b9 da değişim oluyor güzel fakat belirli bir sicil girdiğimde süreki b9 da
değişik siceller değiştirdiğimde
(b9 ) değişsede renk değişimi duruyor




dosya olarak gönderiyorum
yardımcı olursanız sevinirim

 

[Levent Menteşoğlu]

Kodun en üstündeli "dim e,f" yi aşağıdaki ile değiştirerek denermisiniz.

Dim c, d, e, f

 

[redje]

sn leventm

yardımların için teşekkür ederim kendi programıma uyarladım
güzelde oldu hücre rengi hiç siyahada denk gelmedi

fakat bir sorun daha ortaya çıktı mesela
b2 hücresinde 60 ın üzerinde sicil yazılıp değişiyor 55 veya 56 dan sonra
hücre rengi sabitleşiyor değişmiyor neden olabilir

bunuda çözersen sevinirim

 

[Levent Menteşoğlu]

Kodu aşağıdaki ile değiştirin.

[vb:1:ccf7e967cd]Dim c, d, e, f
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$B$2" Then
c = c + 1
Range("B11:C18").Select
Selection.Interior.ColorIndex = c + 2
Target.Select
End If
If Target.Address = "$B$5" Then
d = d + 1
Range("D11:E18").Select
Selection.Interior.ColorIndex = d + 2
Target.Select
End If
If e <> [b9] Then
f = f + 1
[g15].Interior.ColorIndex = f
e = [b9]
End If
If c = 10 Then c = 0
If d = 10 Then d = 0
If f = 10 Then f = 0
End Sub[/vb:1:ccf7e967cd]