hücreye ok yada red yazdırmak

[dr_1356]

merhaba arkadaşlar ben yan taraf hücre -(eksi) syaı çıktıgında bir yan hücresine red yazılacak kırmızı dolgu siyah harf renginde ;eger +(artı) sayı olursa yan hücresine yeşil dolgu beyaz harf rengi şeklinde çıkacakörnek ektedir şimdiden teşekürler....

 

[apocalyt]

sayfa1 sekmenize sağ tıklayp kod görüntele diyin..sonra aşağıdaki kodu oraya yapıştırn..sonra c sutununda herhendi bir hücreye "+" ve "-" değerler girerek deneyiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
If Target.Value < 0 Then
Target.Offset(0, 1).Interior.Color = vbRed
Target.Offset(0, 1) = "RED"
Target.Offset(0, 1).Font.Color = vbBlack
Else
Target.Offset(0, 1).Interior.Color = vbGreen
Target.Offset(0, 1) = "OK"
Target.Offset(0, 1).Font.Color = vbWhite
End If
End Sub

 

[1Al2Ver]

Dosyanız ektedir, umarım yanlış anlamamışımdır.

 

[dr_1356]

çok çok teşekür ederim tam istedigim gibi olmuş

 

[dr_1356]

ya benim sayfada yapamadım örnek dosyada yapabilirmisiniz sorun şurada yan hücreye elle girince yapıyor ama kendi hesaplayınca ok -red yazmıyor şimdiden teşekürler

 

[ZorBey_]

MErhaba
İyi Çalışmalar
Ekli Dosya işinizi Görürmü acaba

 

[apocalyt]

şunu deneyin..sadece "n" sütununda bir hücreye çift tıklayıp enterlayın..

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("n:n")) Is Nothing Then Exit Sub
For x = 7 To [n10000].End(3).Row
If Cells(x, "n") < 0 Then
Cells(x, "n").Offset(0, 1).Interior.Color = vbRed
Cells(x, "n").Offset(0, 1) = "RED"
Cells(x, "n").Offset(0, 1).Font.Color = vbBlack
Else
Cells(x, "n").Offset(0, 1).Interior.Color = vbGreen
Cells(x, "n").Offset(0, 1) = "OK"
Cells(x, "n").Offset(0, 1).Font.Color = vbWhite
End If
Next x
End Sub

 

[dr_1356]

çok teşekür ederim tam istedigim gibi olmuş teşekürler

 

[ZorBey_]

Merhaba
İyi Çalışmalar
Birde Böyle Denermisiniz

n:n leri j:j yaptım

j deki değişiklik olduğunda
istenen sonucu veriyor

If Intersect(Target, Range("n:n")) Is Nothing Then Exit Sub

If Intersect(Target, Range("j:j")) Is Nothing Then Exit Sub