• DİKKAT

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

Metin ve sayı bulunan hücrelerde en küçük değeri bulup kırmızı renkli yazsın

U

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Merhaba arkadaşlar,

Benim amacım 1. ve 2. satırlarda en küçük değeri bulmak. Yanlız şöyle bir sorunum var. bu satırlardaki hücrelerde metin olarak da değer var örnek olarak aynı hücerede "2) 13440 mg /4200 mg" şeklinde ifade de yer almaktadır. Bu şekilde ki hücreler arasında da en küçük değeri bulup kırmızı renkli yapabilir mi?

Not: Ekli dosyada 1. ve 2. satırlarda yazan sayıların en küçüğünü bulup kırmızı renkli yapabilir mi?
 

Ekli dosyalar

1-Hangi rakamlar kıyaslanacak ?
2-Satırlar ayrı ayrı mı değerlendirilecek ?
 
Hamti hocam,

ilgilendiğiniz için teşekkür ederim.

a2:w3 aralığında en küçük sayıyı bulup kırmızıya boyayacak.
 
Merhaba udentr2002. Makro ile mi istiyorusun Koşullu Biçimlendirme ile mi ?
 
Hocam aslında her iki yollada olursa çok makbule geçecektir.

SAYGILARIMLA
 
Merhaba,

Verdiğiniz örnekte en küçük değer 25 midir? yoksa kırmızı ile işaretlediğiniz hücre mi?

İnsanın kafasında soru olunca uğraşmak ta istemiyor.
 
Necdet hocam teşekkürler

a2:w3 aralığında olduğunu belirtmiştim yani 2. ve 3 satırlarda en küçük değeri bulacak. orda kırmızı renkli olan hücre en küçük değeri içeriyor.

Yoruyorum ama kusura bakmayın.
 
udentr2002' Alıntı:
Necdet hocam teşekkürler

a2:w3 aralığında olduğunu belirtmiştim yani 2. ve 3 satırlarda en küçük değeri bulacak. orda kırmızı renkli olan hücre en küçük değeri içeriyor.

Yoruyorum ama kusura bakmayın.
Genişletmek için tıkla ...

Kırmızı renkli hücre : 2) 1992 mg /622,5 mg
bana göre daha küçük değerler var :3) 80 mg / 25 mg

bunların hangisi neye göre küçük?
 
Hocam,

Kusura bakmayın elimden geldiği kadar açıklamaya çalıştım ama eğer anlatamadıysam özür dilerim.

bana göre daha küçük değerler var :3) 80 mg / 25 mg
Genişletmek için tıkla ...

yukarıdaki verilerin olduğu yerler 4. satıra denk geliyor.

ben 2. ve 3. satırlardaki yani a2:w3 aralığında en küçük değerin olduğu veriyi kırmızı renge boyayacak. yani

Kırmızı renkli hücre : 2) 1992 mg /622,5 mg
Genişletmek için tıkla ...

orada 622,5 değeri a2:w3 aralığında en küçük değer olduğu için o hücrede yazanları kırmızıya boyuyorum.

Sizi tekrar yorduğum için kusuruma bakmayın lütfen.

Saygılarımla
 
Merhaba,

Kodları deneyiniz.

Kod: 
Sub MinBul()
    Dim i       As Integer
    Dim j       As Long
    Dim Deger   As Single
    Dim Kucuk   As Single
    Dim Hcr     As Range
    Dim c       As Range
    Dim Adr     As String
    Dim Ara     As String
    Dim dz
    Dim Dizi()  As String
    
    Deger = 9999999
    Range("A2:W3").Font.ColorIndex = 1
    
    For Each Hcr In Range("A2:W3")
        dz = Split(Hcr, " ")
        Kucuk = 9999999
        For i = 0 To UBound(dz)
            dz(i) = Replace(dz(i), "/", "")
            If IsNumeric(dz(i)) = True Then
                If dz(i) < Kucuk Then Kucuk = dz(i)
            End If
        Next i
        
        If Kucuk < Deger Then
            j = 1
            ReDim Dizi(1 To j)
            Dizi(j) = Hcr.Address
            Deger = Kucuk
        ElseIf Kucuk = Deger Then
            j = j + 1
            ReDim Preserve Dizi(1 To j)
            Dizi(j) = Hcr.Address
        End If
        
    Next Hcr
    
    For i = 1 To UBound(Dizi)
        Range(Dizi(i)).Font.ColorIndex = 3
    Next i
    
End Sub
 
Hocam çok çok teşekkürler

Ellerinize sağlık. Hakkınızı helal edin. Uğraştırdım sizi.
 
Hocam tekrar selam.

Sanırım kodda küçük bir sorun var. Denemek için mesala a2:w3 aralıpında herhangi bir yere 20 yazın. içerisinde 20 olan her hücreyi boyuyor. Ama aynı hücreye 22 yazın sadece orayı boyuyor. Dediğim şekilde siz bir kaç deneme yaparsanız belki siz daha iyi anlayabilirsiniz hocam.

saygılarımla
 
Öyle yaptım zaten, ne kadar küçük varsa boyasın dedim.

O zaman ben anlamamışım.
 
Ne kadar küçük varsa değil hocam mesala bir hücrede 20 yazıyor diyelimki başka bir yerde de202 yazıyor
o zaman her iki hücreyide boyuyor eğer 10202 varsa onuda boyuyor. 620 varsada
 
Merhaba,

10 Nolu mesajı yeniledim. Kodları inceleyiniz.
 
Sayın hocam

bilgisayarı işlerimden dolayı şimdi açabildim.

Elinize canınıza sağlık Allah razı olsun.
 
Hocam,
Ben sizin göndermiş olduğunuz kodu kendime uyarlamaya çalıştım ama olmadı.
aşağıdaki kod yardımı ile comboboxlarda yazan verileri sayfadan aratıyorum.

Kod: 
Set S1 = Sheets("Revizyon_Son")
bul = S1.Range("A11:A65536").Find(ComboBox4.Value, , xlValues, xlWhole).Row
bul2 = S1.Range("A9:IV9").Find(ComboBox3.Value, , xlValues, xlWhole).Column

bundan sonra bir çok veriyi ilgili sayfaya aktardıktan sonra,
yukarıda a sütnunda arama yaptığı "bul" değişkenin aldığı değere sizin göndermiş olduğunuz kodları yazmaya çalıştım. Yani sizin gönderdiğiniz "a2:w3"aralığında ki en küçük değeri bulup kırmızıya boyayan kodların ben yukarıda bul diye arattığım değerlere atamak istiyorum. Diyelimki bul değişkeni a sütnunda 12. satıra denk geldi . o zaman sizin gönderdiğiniz kodlar b12:w13 aralığında çalışmalı.ben sizin gönderdiğiniz kodu aşağıdaki gibi düzenlemek istedim ama olmadı.
Kod: 
Set S1 = Sheets("Revizyon_Son")
bul = S1.Range("A11:A65536").Find(ComboBox4.Value, , xlValues, xlWhole).Row
bul2 = S1.Range("A9:IV9").Find(ComboBox3.Value, , xlValues, xlWhole).Column

Deger = 9999999
Range("b & bul:w & bul+1").Font.ColorIndex = 1 
For Each Hcr In Range("b & bul:w & bul+1") 
dz = Split(Hcr, " ")
        Kucuk = 9999999
        For i = 0 To UBound(dz)
            dz(i) = Replace(dz(i), "/", "")
            If IsNumeric(dz(i)) = True Then
                If dz(i) < Kucuk Then Kucuk = dz(i)
            End If
        Next i
        
        If Kucuk < Deger Then
            j = 1
            ReDim Dizi(1 To j)
            Dizi(j) = Hcr.Address
            Deger = Kucuk
        ElseIf Kucuk = Deger Then
            j = j + 1
            ReDim Preserve Dizi(1 To j)
            Dizi(j) = Hcr.Address
        End If
        
    Next Hcr
    
    For i = 1 To UBound(Dizi)
        Range(Dizi(i)).Font.ColorIndex = 3
    Next i
Kırmızı renkli olarak gösterdiğim kod satırı kendi dosyama uyarlamaya çalıştığım yerdir. Ama ben sanırım yanlış düşünüyorum ve kendi dosyama uyarlamaya çalışınca olmuyor. Sizin gönderdiğiniz kodlar normalde çalışıyor.

Kusuruma bakmazssanız. Tekrar bakabilmeniz mümkünmü acaba hocam.
 
Son düzenleme:
Konu ile ilgili başka çözümlerde olabilir. Yardımlarınızı rica ediyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst