• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Koşullu biçimlendirme

Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Merhaba arkadaşlar,

Continational Formating i kullanmadan VBA ile nasıl halledeceğimi bulamadığım bir sorum olacak.

A2 ile A10 arasında ki sayıların içinde maximum olanın fontunu sarı yapsın.
Hatta mümkünse seçili alanda maximum olan sayının fontunu sarı yapmak istesem çok mu olur:))
 
Merhaba arkadaşlar,

Continational Formating i kullanmadan VBA ile nasıl halledeceğimi bulamadığım bir sorum olacak.

A2 ile A10 arasında ki sayıların içinde maximum olanın fontunu sarı yapsın.
Hatta mümkünse seçili alanda maximum olan sayının fontunu sarı yapmak istesem çok mu olur:))

Merhaba
Buton yardımı ile bu kodu deneyiniz_?
Kod:
Option Explicit
Sub seçili_büyük()
Dim İLK As Variant, SON As Variant
Dim BUL As Range, ARA As Long, SÜT As String
Dim VERİ, SÜTUN As String
Cells.Interior.ColorIndex = xlNone
İLK = ActiveCell.Address
If Selection.Columns.Count > 1 Then
VERİ = Split(Selection.Address, ":")
SÜTUN = Split(VERİ(UBound(VERİ)), "$")(0)
SON = Split(VERİ(UBound(VERİ)), "$")(1) & ActiveCell.Row + Selection.Rows.Count - 1
ARA = WorksheetFunction.Max(Range(İLK & ":" & SON))
Set BUL = Range(İLK & ":" & SON).Find(ARA)
Cells(BUL.Row, BUL.Column).Interior.Color = vbYellow
Else
SÜT = Replace(Replace(İLK, "$", ""), ActiveCell.Row, "")
SON = ActiveCell.Row + Selection.Rows.Count - 1
ARA = WorksheetFunction.Max(Range(İLK & ":" & SÜT & SON))
Set BUL = Range(İLK & ":" & SÜT & SON).Find(ARA)
Cells(BUL.Row, BUL.Column).Interior.Color = vbYellow
End If
MsgBox "En Büyük Değer : " & ARA & vbLf _
& "İşlem tamamlandı", vbInformation
End Sub
Seçili alandakilere göre hareket eder.
 
Buda alternatif olsun.
Kod:
Option Explicit
Sub seçili_büyük()
Dim SAT As Range, SAB As String, ARA As Long
Cells.Interior.ColorIndex = xlNone
ARA = WorksheetFunction.Max(Selection)
Set SAT = Selection.Find(ARA, , , xlWhole)
If Not SAT Is Nothing Then
SAB = SAT.Address
Do
SAT.Interior.ColorIndex = 6
Set SAT = Selection.FindNext(SAT)
Loop While Not SAT Is Nothing And SAT.Address <> SAB
End If
MsgBox "En Büyük Değer : " & ARA & vbLf _
& "İşlem tamamlandı", vbInformation
End Sub
 
Bir sorum daha var arkadaşlar,
İki koşulum var, koşulları sağladığı satırı renklendirmesini istiyorum.
örnek dosyam ekte, yardımcı olabilir misiniz lütfen
 

Ekli dosyalar

Bir sorum daha var arkadaşlar,
İki koşulum var, koşulları sağladığı satırı renklendirmesini istiyorum.
örnek dosyam ekte, yardımcı olabilir misiniz lütfen

Bu kod dener misiniz_?
Kod:
Option Explicit
Sub seçili_büyük()
Dim SAT As Long, SÜT As Long
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone
For SAT = 7 To Cells(Rows.Count, "A").End(xlUp).Row
For SÜT = 3 To Cells(7, Columns.Count).End(xlToLeft).Column
If Cells(SAT, SÜT) <> Empty And Cells(SAT, SÜT) >= 100 Then
Cells(SAT, SÜT).Interior.Color = vbRed
End If: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub
 
Olmadı üstadım ben olayın anlaşılabilmesi için iki madde ile gidişatın nasıl oması gerektiğini anlatmaya çalıştım. Dosyam ekte
 

Ekli dosyalar

1) Her bir müşteri satırında örnek de C7 ile F7 hücrelerinde >100 kaşulu gerçekleşirse
2) He bir müşteri için C6 ve F6 hücrelerindeki max % değerinin altındaki hücre renklenecek.
A müşterisi için F7
B müşterisi için C8
C müşterisi için E9 hücresi bu koşulları sağlıyor.
D müşterisi için hiç bir koşul sağlanmadığı için birşey olmayacak.
 
üstadım ben sisin kodu çalıştırdığımda seçili alandaki tüm 100 e eşit ve büyük değerleri renklendiriyor. Ama bir kontrol daha var ki kodun içine açıklamasını yazdım.


Sub seçili_büyük()
Dim SAT As Long, SÜT As Long
'Application.ScreenUpdating = False
'Cells.Interior.ColorIndex = xlNone
For SAT = 7 To Cells(Rows.Count, "A").End(xlUp).Row
For SÜT = 3 To Cells(7, Columns.Count).End(xlToLeft).Column
If Cells(SAT, SÜT) <> Empty And Cells(SAT, SÜT) >= 100 Then

'yukarıda iligili alanda >=100 den büyük var mı diye kontrol etti tamam ama renklendirmeden önce
'tam burada bir kontrol daha gerekiyor
'kırmızı yapmadan önce C6 ile C7 arasındaki değerlerin max ını bulup A kolonu ile maxın kesiştiği hücreyi renklandirmesi gerekiyor.


Cells(SAT, SÜT).Interior.Color = vbRed
End If: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub
 
Neye göre %10 - %20 - %30 olarak hesaplattıracağız onu söylememişsiniz_?
 
bir hesaplama yapılmayacak, sadece c6 ile f6 arasındaki % değerlerinden max olanı referans alıp C7 iel F7 arasındaki değerlerin içinden renklendirmesi gerekeni bulacak. Ancak bulduğu alandaki değer 100 den küçükse müşteri c de olduğu gibi Max dan bir küçük olan değerin kesiştiği hücreyi renklendirecek. Çok karışmadı umarım:))
 
bir hesaplama yapılmayacak, sadece c6 ile f6 arasındaki % değerlerinden max olanı referans alıp C7 iel F7 arasındaki değerlerin içinden renklendirmesi gerekeni bulacak. Ancak bulduğu alandaki değer 100 den küçükse müşteri c de olduğu gibi Max dan bir küçük olan değerin kesiştiği hücreyi renklendirecek. Çok karışmadı umarım:))

Sanırım anlatamadım.
Müşteri Açıklama 10% 20% 25% 30%
A Gerçekleşme% 236,65 169,34 131,84 107,94
B Gerçekleşme% 100,00 73,75 57,34 46,90
C Gerçekleşme% 185,73 132,70 103,23 84,47
D Gerçekleşme% 99,90 64,46 50,25 41,07

Dosyanızdaki değerler bunlar
30% nin altındaki 107,94 boyansın demişsin nasıl boyanacak kriter nedir.
Ben kriteri göremedim. Neye göre boyanacak bu_?
 
O değerler üzerinde hiç bir hesap yaptırmadan,
1. koşul A müşterisindeki rakamlar için ; C7 ile F7 kolonunda >=100 değeri varmı, varsa 1 den fazla ise >=100 değerler,
renklenecek hücreyi C6 ve F6 hücrelerindeki max değerleri referans alarak (hiç bir hesaplama yapılmayacak) reklendireceğiz.
A müşterisi için tüm değerler 100 den büyük o zaman c6:f6 arasındaki max değerin kesiştiğ değer 107,94 tür.

2.koşul aynı şartlar altında kesiştiğ hücredeki değer 100 den küçükse o zaman C6:f6 daki ondan sonraki en büyük değerin kesiştiği değer olacak, C müşterisinde olduğu gibi. 103,23

3.koşul, eğer >=100 sadece bir tane varsa o zaman kendisi renklenecek
B müşterisinde olduğu gibi

4. koşul >=100 yoksa hiçbir olmayacak
 
Merhaba
Umarım bu sefer olmuştur.
Kod:
Option Explicit
Sub seçili_büyük()
Dim SAT As Long
Application.ScreenUpdating = False
Range("C7:F" & Rows.Count).Interior.ColorIndex = xlNone
For SAT = 7 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(SAT, "C") >= 100 And Cells(SAT, "D") < 100 And _
Cells(SAT, "E") < 100 And Cells(SAT, "F") < 100 Then
Cells(SAT, "C").Interior.Color = vbRed
End If
If Cells(SAT, "C") < 100 And Cells(SAT, "D") >= 100 And _
Cells(SAT, "E") < 100 And Cells(SAT, "F") < 100 Then
Cells(SAT, "D").Interior.Color = vbRed
End If
If Cells(SAT, "C") < 100 And Cells(SAT, "D") < 100 And _
Cells(SAT, "E") >= 100 And Cells(SAT, "F") < 100 Then
Cells(SAT, "E").Interior.Color = vbRed
End If
If Cells(SAT, "C") < 100 And Cells(SAT, "D") < 100 And _
Cells(SAT, "E") < 100 And Cells(SAT, "F") >= 100 Then
Cells(SAT, "F").Interior.Color = vbRed
End If
If Cells(SAT, "C") >= 100 And Cells(SAT, "D") >= 100 And _
Cells(SAT, "E") < 100 And Cells(SAT, "F") < 100 Then
Cells(SAT, "D").Interior.Color = vbRed
End If
If Cells(SAT, "C") >= 100 And Cells(SAT, "D") >= 100 And _
Cells(SAT, "E") >= 100 And Cells(SAT, "F") < 100 Then
Cells(SAT, "E").Interior.Color = vbRed
End If
If Cells(SAT, "C") >= 100 And Cells(SAT, "D") >= 100 And _
Cells(SAT, "E") >= 100 And Cells(SAT, "F") >= 100 Then
Cells(SAT, "F").Interior.Color = vbRed
End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub
 
Merhaba arkadaşlar,
Koşullu biçimlendirme ile kırmızı, sarı ve yeşil ok ları kullanıyorum.İki hücrenin farkı >0 dan büyükse kırmızı okun yukarı göstermesini nasıl sağlarım.Kırmızı ok hep aşağı gösteriyor, yukarı gösteren varmı bulamadım. Rica etsem yardımcı olabilir misiniz?
 
Herkese merhaba arkadaşlar,
Continational Formating ile bir hücrenin değerini kontrol ettirip yukarı aşağıya ok getirmek istiyorum.
Mesela A1 hücresinde 100 var ben b1 dki rakamla c1 deki rakamı toplatıp çıkan değer A1 den büyükse A de yukarı ok çıkacak küçükse aşağı ok çıkacak. Bunu formulle denedim ama olmadı yardımcı olur musunuz rica etsem.
 
Geri
Üst