Hücre içerisindeki sayı değiştiğinde renginin de değişmesi?

[poul81]

Merhaba arkadaşlar.

Forumu talan ettim, belkide yanlış sözcüklerle aradım, neyse sonuçta bulamadım.

Kısaca isteğim şudur; Tabi ihtimali varsa, ki makro ile çözülebileceğini düşünüyorum.

Farzı misal A1 hücresinde sayısal bir değerimiz mevcut.
Bu sayı diyelim 55, ben 56 yada üstü bir değer girersem hücre içi yeşil, var olan değerden aşağı bir değer girersem kırmızı olsun istiyorum.
Kısacası artan azalan sayıyı, algılayan bir fonksiyon. Aynı endexler, kur tablolarında gördüğümüz gibi.

Herkese şimdiden teşekkürler.

 

[asi_kral]

Merhaba arkadaşlar.

Forumu talan ettim, belkide yanlış sözcüklerle aradım, neyse sonuçta bulamadım.

Kısaca isteğim şudur; Tabi ihtimali varsa, ki makro ile çözülebileceğini düşünüyorum.

Farzı misal A1 hücresinde sayısal bir değerimiz mevcut.
Bu sayı diyelim 55, ben 56 yada üstü bir değer girersem hücre içi yeşil, var olan değerden aşağı bir değer girersem kırmızı olsun istiyorum.
Kısacası artan azalan sayıyı, algılayan bir fonksiyon. Aynı endexler, kur tablolarında gördüğümüz gibi.

Herkese şimdiden teşekkürler.

Merhaba
Bunu koşullu biçimlendirme ile yapabilirsiniz.
Örneğin : Belirlediğiniz rakam A1 hücresinde diğer rakamını ise B1 hücresi olsun B1'i seçin Koşullu Biçimlendirme - Yeni Kural - Biçimlendirilecek Hücreleri Belirlemek İçin Formül Kullan - Formül Kutucuğuna

=$A$1<$B$1

Bunu yazın ve Biçimlendir - Dolgudan Yeşil'i seçin Tamam Diyerek Koşulu Bitirin.
Diğer Koşul İçin ise B1 Hücresi seçili iken Yeni Kural - Biçimlendirilecek Hücreleri Belirlemek İçin Formül Kullan - Formül Kutucuğuna

=$A$1>$B$1

Bunu yazın ve Biçimlendir - Dolgudan Kırmızıyı seçin ve tamam diyerek koşulu bitirin. Sonuçları gözlemleyin.

 

[Korhan Ayhan]

Merhaba,

Aynı hücre üzerinde bu işlemi yapacaksanız aşağıdaki kodu ilgili sayfanın kod bölümüne uygulayın.

Sayfa adı üzerinde sağ klik yapın.
Kod görüntüle seçeneğini seçin.
Açılan beyaz renkli bölüme kodu uygulayın.

Option Explicit
Dim Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Target < Veri Then Target.Interior.ColorIndex = 3
    If Target > Veri Then Target.Interior.ColorIndex = 4
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Veri = Target
End Sub

 

[poul81]

Tesekkurler

Asi kral ilgi alakan için teşekkür ederim ama sorum tek hücre içindi, yinede saol.

Korhan bey tam aradığım kodu yazmışsınız ellerinize sağlık, çok teşekkürler.

 

[poul81]

Option Explicit
Dim Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Target < Veri Then Target.Interior.ColorIndex = 3
    If Target > Veri Then Target.Interior.ColorIndex = 4
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Veri = Target
End Sub

Bu kodu dinamik hücreyede uygulayabilir miyiz?

 

[Orion1]

Eşitse ne olacak?!!

 

[poul81]

Eşitse ne olacak?!!

Üçüncü bir renk uygulanabilir, mavi mesela.

 

[Korhan Ayhan]

Merhaba,

Değişiklik olacak hücre kaynağını kod içinde tanımlayabilirsiniz.

Range("D2:D20")

Kodu tamamen derleceyek olursak;

Option Explicit
Dim Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D2:D20")) Is Nothing Then Exit Sub
    If Range("A1") < Veri Then Range("A1").Interior.ColorIndex = 3
    If Range("A1") > Veri Then Range("A1").Interior.ColorIndex = 4
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Veri = Range("A1")
End Sub

 

[poul81]

Merhaba,

Değişiklik olacak hücre kaynağını kod içinde tanımlayabilirsiniz.

Range("D2:D20")

Kodu tamamen derleceyek olursak;

Option Explicit
Dim Veri As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D2:D20")) Is Nothing Then Exit Sub
    If Range("A1") < Veri Then Range("A1").Interior.ColorIndex = 3
    If Range("A1") > Veri Then Range("A1").Interior.ColorIndex = 4
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Veri = Range("A1")
End Sub

Emekleriniz için tekrar tekrar teşekkür ederim.
Kod mantık olarak çok iyi çalışıyor, sorunu yok ama benim istediğim A1 hücresi haricinde hiç bir hücre ile bağıntılı olmayan bir uygulama. Yani kolonlara yada D220 arası hücrelere bağlı olmadan kendi içerisindeki değişikliği algılayan bir kod var mı.

Neden soruyorum, şundan; eğer öyle bir kod var ise şayet, internet üzerindeki herhangi bir xml (xlm, htm, v.b.) dosyasından excel içine çeklilen dinamik veriyi bu kod algılamayacak. Ama bağımsız olursa süper olur.

Çünkü verinin geldiği kaynak sürekli değişebilir bu da kodun sürekli değiştirilmek zorunda olması anlamına gelir.

İmkansız yada çok uğraştırıcı bir işlemi varsa anlarım problem değil.

 

[Korhan Ayhan]

Merhaba,

Çalışmanıza boş bir modül ekleyin ve aşağıdaki kodu uygulayın. Kod içindeki sayfa adını kendi sayfa adınıza göre güncelleyin.

Option Explicit
Public X
 
Sub AUTO_OPEN()
    Application.OnTime Now + TimeValue("00:00:01"), "Veri"
End Sub
 
Sub Veri()
    DoEvents
    X = Sheets("Sayfa1").Range("A1").Value
End Sub

Bu işlemi yapacağınız sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

Private Sub Worksheet_Calculate()
    If Range("A1") = X Then Range("A1").Interior.ColorIndex = 8
    If Range("A1") < X Then Range("A1").Interior.ColorIndex = 3
    If Range("A1") > X Then Range("A1").Interior.ColorIndex = 6
    AUTO_OPEN
End Sub

Dosyanızı kayıt edip kapatıp açın. 1 dakika sonraki otomatik güncellemedeki renk değişimini kontrol edin.

 

[poul81]

Süpersin

Merhaba,

Çalışmanıza boş bir modül ekleyin ve aşağıdaki kodu uygulayın. Kod içindeki sayfa adını kendi sayfa adınıza göre güncelleyin.

Option Explicit
Public X
 
Sub AUTO_OPEN()
    Application.OnTime Now + TimeValue("00:00:01"), "Veri"
End Sub
 
Sub Veri()
    DoEvents
    X = Sheets("Sayfa1").Range("A1").Value
End Sub

Bu işlemi yapacağınız sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

Private Sub Worksheet_Calculate()
    If Range("A1") = X Then Range("A1").Interior.ColorIndex = 8
    If Range("A1") < X Then Range("A1").Interior.ColorIndex = 3
    If Range("A1") > X Then Range("A1").Interior.ColorIndex = 6
    AUTO_OPEN
End Sub

Dosyanızı kayıt edip kapatıp açın. 1 dakika sonraki otomatik güncellemedeki renk değişimini kontrol edin.

Yardım ettiğin ve öğretmeye çalıştığın için çok saol. Mükemmel çalışıyor.
10 numara adamsın, çok sağ ol.

 

[poul81]

Dosya Ektedir

İşine yarayacak olan arkadaşlar edinsin diye örnek dosyayı ekte veriyorum.

Korhan Ayhan arkadaşımızın çalışması.

 

[ageblood]

Çözümü burada bulduğum için yeni konu açmak istemedim ama

Option Explicit
Dim Veri As Variant

Private Sub worksheet_change(ByVal Target As Range)
If Intersect(Target, Range("H153")) Is Nothing Then Exit Sub
If Target < Veri Then Target.Interior.ColorIndex = 3
If Target > Veri Then Target.Interior.ColorIndex = 4

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Veri = Target
End Sub


formülünü oluşturarak belirli aralıkta çalışmasını istiyorum.
Fakat sadece elle girilmelerde çalıştırabildim. Hücrelerin hepsi formüllü.
Kod'a birşey ekleyerek formüllü olsa da kod'a tepki vermesini sağlayabilir miyiz?

 

[ageblood]

Çözümü burada bulduğum için yeni konu açmak istemedim ama

Option Explicit
Dim Veri As Variant

Private Sub worksheet_change(ByVal Target As Range)
If Intersect(Target, Range("H153")) Is Nothing Then Exit Sub
If Target < Veri Then Target.Interior.ColorIndex = 3
If Target > Veri Then Target.Interior.ColorIndex = 4

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Veri = Target
End Sub


formülünü oluşturarak belirli aralıkta çalışmasını istiyorum.
Fakat sadece elle girilmelerde çalıştırabildim. Hücrelerin hepsi formüllü.
Kod'a birşey ekleyerek formüllü olsa da kod'a tepki vermesini sağlayabilir miyiz?

İlgelenebilen var mıdır acaba?

 

[Korhan Ayhan]

Merhaba,

Örnek dosyanızı ekleyerek yapmak istediğiniz işlemi açıklarsanız yardımcı olmaya çalışırız.

 

[ageblood]

Merhaba,

Örnek dosyanızı ekleyerek yapmak istediğiniz işlemi açıklarsanız yardımcı olmaya çalışırız.

Merhabalar,

Detail Items sayfasındaki H'tan V' sütununa kadar olan değerlerde bir değişiklik olduğunda renklendirilmesini istiyorum.
Hepsi formüllü ve server'dan başka excel'lerden almakta değerleri.
Diğer exceller kapalı olarak çalışmasını istediğimden dolayı önce ek sayfalara çekiyorum, oradan formülletiyorum.
Basit bir makro ile güncelleme yaptırtıyorum. Çok değer olduğundan dolayı hangi hücrenin arttığını/azaldığını görebilmek için istiyorum.

Teşekkür ederim.

 

[ageblood]

Merhabalar,

Detail Items sayfasındaki H'tan V' sütununa kadar olan değerlerde bir değişiklik olduğunda renklendirilmesini istiyorum.
Hepsi formüllü ve server'dan başka excel'lerden almakta değerleri.
Diğer exceller kapalı olarak çalışmasını istediğimden dolayı önce ek sayfalara çekiyorum, oradan formülletiyorum.
Basit bir makro ile güncelleme yaptırtıyorum. Çok değer olduğundan dolayı hangi hücrenin arttığını/azaldığını görebilmek için istiyorum.

Teşekkür ederim.

Sorunum günceldir.