excelde bir şekli hücre değerine göre renklendirme

[gravity80]

Selamlar.

Forumda, konu başlığı olarak yazdığım metni aradım, bir eşleşme bulamadım.

Konu hakkında yardımcı olabilecek birileri var ise yardım rica ediyorum.

Aşağıdaki kodu Sheet1 içine Worksheet ve Change yordamları ile ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160704
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < 100 Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= 100 And Target.Value < 200 Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub

Sheet1'e eklediğim Oval 1, A1 hücresinin değerine göre renk değiştiriyor.
Şimdi Sheet 1'e yeni bir oval daha eklemek istiyorum, koşulları ilk şekil ile aynı olabilir, farklı da olabilir.
Sonrasında Oval 3, Oval 4 de ekleyeceğim...

Yukarıdaki kodu aynen yazıp, Oval 1 ifadesini Oval 2 yaparsam, kod birebir aynı olmasa da ilk satırı aynı olduğu için çalıştıramıyorum.
Bu kodları aynı yerde ancak birbirinden farklı olarak nasıl yazabilirim?

 

[Necdet]

Merhaba,
Ben tüm Oval ile başlayan şekillleri renklendirmek olarak anladım. Eğer amacınız bu ise aşağıdaki kodları deneyebilirsiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    
    Dim shp As Shape
    If IsNumeric(Target.Value) Then
        For Each shp In ActiveSheet.Shapes
            If shp.Name Like "Oval*" Then
                If Target.Value < 100 Then
                    shp.Fill.ForeColor.RGB = vbRed
                ElseIf Target.Value >= 100 And Target.Value < 200 Then
                    shp.Fill.ForeColor.RGB = vbYellow
                Else
                    shp.Fill.ForeColor.RGB = vbGreen
                End If
            End If
        Next shp
    End If
    
End Sub

 

[gravity80]

Doğru anlamışsınız, kodlar da çalıştı.
Excelde bu da yoktur, varsa da çözümü yoktur dediğim her konuda saolsun siteden biri mutlaka cevap yazıyor.
Teşekkür ediyorum, bu arada vardiyalı çalışıyorum, cevap geldiğini bu sabah iş çıkışında gördüm ancak kodları henüz yazdım, geç dönüşümün sebebi budur.
Saygılarımla...

 

[gravity80]

Yeniden merhaba.
Sıklıkla olmasa da Excel üzerinde bazen çözüme ulaştığını düşündüğüm bir konu, farklı varyasyonlar sebebi ile yeni bir sorunsala dönüşebiliyor, kodlar çalıştı dedim ama dediğim gibi bir farklılık ortaya çıktı, bu sebeble tekrar yardım rica ediyorum.

İlgilenebilecek değerli abilelere şimdiden teşekkür ediyorum.
Not: Konuyu eksiksiz anlatmaya çalışacağım, bundan ötürü de kullanacağım betimler deyatlı olabilir.

Şimdi, iki sayfalı bir excel dosyası düşünün.
İlk sayfanın ismi veri, diğeri de trend olsun.
İkinci sayfada 3 tane oval şekil olacak. (3 diyorum, kodu öğrenebilirsem zaten daha fazlasını kendim de ekleyebilirim)
Trend sayfasındaki ilk oval, veri sayfasındaki A1 hücresinden değer çekecek.
Trend sayfasındaki ikinci oval, veri sayfasındaki A2 hücresinden değer çekecek.
Trend sayfasındaki üçüncü oval, veri sayfasındaki A3 hücresinden değer çekecek.

İlk oval, A1 hücresi 1 ile 10 arasında ise kırmızı, 11 ile 20 arasında ise yeşil, 21 ile 30 arasında ise mavi olacak.
Bu koşullar diğer oval şekiller için farklı olacak, yani onların sayısal aralıkları ilk oval ile aynı olmayacak.
Ancak dediğim gibi kodu öğrenebilirsem uyarlamayı diğerleri için kendim yapabilirim, o yüzden bir aralık belirtmiyorum,
yani ilk oval sayısal değerlerini bunlar için de kabul edebilirsiniz.

Bu konunun sorduğum ve cevabını aldım dediğim konudan farkı, şekillerin farklı hücrelerden değer alıyor olması.
Diğer konuda tüm şekiller aynı hücreye bağlı idi.

saygılarımla...