Kodlarla koşullu biçimlendirme

[Sa.NaL]

Merhaba benim excel uzmanı arkadaşlardan ricam: ekte bulunan dosyamda koşuullu biçimlendirme yapmak istiyorum ama kodlarla, koşullu biçimlendirme menüsünü kullanarak değil nasıl yaparım yardımlarınızı bekler şimdiden tşkler ederim.

 

[dEdE]

Merhaba,
Dosyanız ilişiktedir.

Sub Boya()
eK = WorksheetFunction.Min(Range(Cells(1, 1), Cells(10, 1)))
For i = 1 To 10
If Cells(i, 1).Value = eK Then Cells(i, 1).Interior.ColorIndex = 4
Next
End Sub

 

[leumruk]

Selamlar,

Sub biçim()
Sat = [a65536].End(3).Row
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For x = 1 To Sat
Cells(x, "a").Interior.ColorIndex = xlNone
If Cells(x, "a") = Min Then Cells(x, "a").Interior.ColorIndex = 4
Next
End Sub

 

[leumruk]

Etme bulma dünyası, bu sefer de ben 1 dk gecikmişim. Yalnız benim bir satır fazlam var.:biggrin:

 

[Sa.NaL]

vallahi hızır gibi yetiştiniz çok tşkler

 

[leumruk]

Merhaba,
Bu kodla da buton kullanmadan uygulama yapabilirsiniz. Sayfa1'in kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [a65536].End(3).Row
If Intersect(Target, Range(Cells(1, "a"), Cells(Sat, "a"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For Each x In Range(Cells(1, "a"), Cells(Sat, "a"))
x.Interior.ColorIndex = xlNone
If x = Min Then x.Interior.ColorIndex = 4
Next
End Sub

 

[dEdE]

Etme bulma dünyası, bu sefer de ben 1 dk gecikmişim. Yalnız benim bir satır fazlam var.:biggrin:

Öncekinde benim 2 satır fazlam vardı. :hihoho:

 

[Sa.NaL]

Tşkler hocam benim başka bir örneğiimde "hesap" adlı sayfasına bu kodları yazsam ama dosyamda şöyle bir durum söz konusu "tasarım" adlı sayfada I3 de bulunan efektif güç sayısına hesap sayfasında R2 den R 65 e kadar çıkan sonuçlardan "EN YAKINI" hangisi ise o hücre rengi yada rengleri Yeşil olsun bunu yapabilirmiyim bu kodlarla yoksa değişiklik gerekirmi?

 

[leumruk]

Anladığım kadarıyla, sayı farkı sadece küsüratta. Sayı farkı küsurat olunca minimum değer belirttiğiniz hücre adresindeki sayıya en yakın sayı anlamına geliyor. Dolayısıyla verdiğim kod yapısı kullanılabilir. Ancak, sebebini anlamadığım şekilde sadece bir hücreyi renklendiriyor; aynı diğer sayıları renklendirmiyor. Sayıları formülle almışsınız, belki onunla bir ilgisi vardır, ama emin değilim. Çünkü formül yerine elle sayı girdiğimde kod pürüzsüz çalışıyor.
Kod çalışıyor, uygun. Ama sizin dosyanızın o sütununa neden uyum sağlamadı, çözemedim.

 

[Sa.NaL]

tşkler ben farklı bir yol denedim S2 den S65e kadar R2den R65 e kadarki kısımdan I 3 ü çıkararak s e yazdırdım ve hesap sayfası altına verdiğiniz kodu yazdırdım istediğim oldu sorun çıkarsa size tekrar danışırım yardımlarınız için çok tşk ederim İyiki varsınız

 

[leumruk]

Aslında kod kullanmadan da yapılabilir. Kod kullanmanız zorunlu değilse aşağıdaki formülü ilgili hücrelerin koşullu biçimlendirme ayarlarına kopyalayıp biçim ayarını yeşil yaptığınız da da olur.
=r2=min(r2:r65)

 

[Sa.NaL]

o zaman if döngüsü kuramıyorum o satırlara formandiation(1) diye kuruncada devamlı sabit renkte kalıyor o zamanda eski halini alamıyor bu dediğimi belki anlamamış olabilirsiniz günlerdir aslında başıma gelen hadiseler beni bu yola itti ilk denemem o şekildi aslında ama benim bunun devamında başka döngülerim engel teşkil etti koşullu biçimlendirme işine ama yinede tşkler.İyi çalışmalar peki şu döngüm şunu anlatmıyor mu hocam

Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [s65536].End(3).Row
If Intersect(Target, Range(Cells(2, "s"), Cells(Sat, "s"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(2, "s"), Cells(Sat, "s")))
For Each x In Range(Cells(2, "s"), Cells(Sat, "s"))
x.Interior.ColorIndex = xlNone
If x = Min And x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = 4
Next
End Sub

s2den s65 e kadar olan satırlardan rengi kırmızıdan farklı olan sayılardan hangisi minimumsa o hücre rengi yeşil olsun ama eleme işlemi value boşluk yaparak olmasın o şekilde düşündüm formülde siliniyor bir daha formül eski halini almıyor
yaptırmak istediğim bu ama olmuyor tam olarak şu istediğim kırmızı olanlar elensin geri kalan sayılar arasında minimum aransın ve o hücre rengi yeşil olsun bunu kangi kodla yapabilirim?

 

[leumruk]

Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [s65536].End(3).Row
If Intersect(Target, Range(Cells(2, "s"), Cells(Sat, "s"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(2, "s"), Cells(Sat, "s")))
For Each x In Range(Cells(2, "s"), Cells(Sat, "s"))
[COLOR="Red"]If x.Interior.ColorIndex <> 3 Then[/COLOR] x.Interior.ColorIndex = xlNone
If x = Min And x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = 4
Next
End Sub

Döngü esnasında önce tüm hücrelerin rengi sıfırlanıyor, sonra yeşile boyanıyordu. Dolayısıyla kırmızı hücre diye bir şey kalmıyordu. Eklediğim satırla durumu düzelttim.

 

[Sa.NaL]

hocam olmadı yani şunu yapmak istedim ama olmadı ben bi kritere göre s2 : s65 arası bazı sayıların olduğu hücreleri kırmızıya eşitleyerek eliyorum o elenenler sizin minimum buldurma limitiniz s2 : s65 e kısmından elensin geriye kalan sayılar arasından mininmum bulunarak o sayının bulunduğu hücre yeşil olsun bu kod yukarıdaki gibi değil sanırım denedim olmadı sizde deneyip bana sorunu bildirirseniz günlerdir uğrraştığım problemin sonu gelmiş olacak hocam

 

[Sa.NaL]

bu kod şunu yapıyor minimumu bulduruyor ama o minimum ya kırmızılar arasında ise yeşil renk işe yaramıyor hücre kırmızı kalıyor

 

[leumruk]

Son haliyle dosyayı ekleyebilir misiniz? Onun üzerinde deneyeyim.

 

[Sa.NaL]

Son haliyle dosyayı ekleyebilir misiniz? Onun üzerinde deneyeyim.

Hocam ilk kriter bitti daha onun için yakıt tipinden 1. seçeneği (işleminizi yaptıkça) seçerek ekleyeceklerinizin çalışıp çalışmadığını anlayabilirsiniz çok sağolun

 

[Sa.NaL]

kırmızı olan sayılar elensin yani hocam geriye kalan beyaz hücredeki sayılar arasından minumum sayı yada sayılar bulunarak o hücreler yeşil olsun istiyorum tabi olursa bu olursa zaten tamamdır mutlu son

 

[leumruk]

bu kod şunu yapıyor minimumu bulduruyor ama o minimum ya kırmızılar arasında ise yeşil renk işe yaramıyor hücre kırmızı kalıyor

Anladım siz, hücre minimum değilse kırmızı kalmasını istiyorsunuz. Aksi takdirde kırmızı da olsa yeşil olsun.

Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [a65536].End(3).Row
If Intersect(Target, Range(Cells(1, "a"), Cells(Sat, "a"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For Each x In Range(Cells(1, "a"), Cells(Sat, "a"))
If x = Min Then x.Interior.ColorIndex = xlNone
If x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = xlNone
If x = Min And x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = 4
Next
End Sub

 

[Sa.NaL]

hayır hocam hücre kırmızı olanlar artık elendi onların yeşil olma şansı kalmadı ben geriye kalan beyaz hücreler arasından minimum aransın istiyorum artık ve o minimumda yeşil olsun