En Büyük ve Küçük Değeri Bul Dolu Satırları İşaretle

1mak1mak · 20 Mart 2011

Ekteki gibi bir tablom var ben bu tabloya bir Buton Ekledim
Butona bastığımda Bana En Büyük ve En Küçük Değeri Mesaj Box olarak veriyor.

Ben aynı zamanda Butona tıkladığımda Değerler Hangi Hücredeyse O dolu olan Satırlarıda Seçim olarak göstermesini istiyorum.
Esasında Bunları Ayrı Ayrı Butonlarda Yapabiliyorum ama Tek Butonda Bu işlemi yapabilirmiyim?

Ayrı Butonlarda Görmemi Sağlayan Kodlar Örnek olarak

Private Sub CommandButton1_Click()
Dim buyuk As Double
Dim sira As Integer
Dim satir As Integer

buyuk = WorksheetFunction.Max(Range("C:C"))

sira = WorksheetFunction.Match(buyuk, Range("C:C"), 0)

satir = sira

Range("C" & satir).Select
End Sub
-------------------------------------------------------------------
Private Sub CommandButton2_Click()
Dim buyuk As Double
Dim sira As Integer
Dim satir As Integer

buyuk = WorksheetFunction.Min(Range("C:C"))

sira = WorksheetFunction.Match(buyuk, Range("C:C"), 0)

satir = sira

Range("C" & satir).Select
End Sub

Oda Sadece Tekbir Hücreyi Seçiyor bense Büyük veya Küçük değerin olduğu Dolu olan o Satırdaki yan yana 4.Hücreyi de
seçmesini istiyorum.

Bu İşlemlerin Hepsini Tek Bir Butonla Yapabilirmiyim?

İlgilenenlere Teşekkürler

ynmcan · 20 Mart 2011

Syn.1Mak1Mak;
Dosyanız ekte.

Kod:

Private Sub CommandButton1_Click()
Dim vMax, vMin

vMax = WorksheetFunction.Max(Range("C:C"))
vMin = WorksheetFunction.Min(Range("C:C"))


MsgBox "En Büyük Değer " & vMax & vbCrLf & _
       "En Küçük Değer " & vMin, vbInformation, "Max & Min"
       
       For sat = 1 To 100
       For i = 1 To 4
       Cells(sat, i).Interior.ColorIndex = xlNone
       If Cells(sat, 3) = vMax Then Cells(sat, i).Interior.ColorIndex = 3
       If Cells(sat, 3) = vMin Then Cells(sat, i).Interior.ColorIndex = 4
       Next i
       Next sat
End Sub

1mak1mak · 20 Mart 2011

ynmcany' Alıntı:

Syn.1Mak1Mak;
Dosyanız ekte.

Kod:

Private Sub CommandButton1_Click()
Dim vMax, vMin

vMax = WorksheetFunction.Max(Range("C:C"))
vMin = WorksheetFunction.Min(Range("C:C"))


MsgBox "En Büyük Değer " & vMax & vbCrLf & _
       "En Küçük Değer " & vMin, vbInformation, "Max & Min"
       
       For sat = 1 To 100
       For i = 1 To 4
       Cells(sat, i).Interior.ColorIndex = xlNone
       If Cells(sat, 3) = vMax Then Cells(sat, i).Interior.ColorIndex = 3
       If Cells(sat, 3) = vMin Then Cells(sat, i).Interior.ColorIndex = 4
       Next i
       Next sat
End Sub

Teşekkür ederim Ellerinize sağlık.
Yalnız Renklendirme yerine başka birşey olsa daha iyi yani geçici göstermesi
Çünki çıkışta dosyayı kaydediyorum daha sonra bu değerler değişebilir
başka bir satırda büyük veya küçük olabilir o zamanda renkler birbirine karışacak.
Geçici renklendirme olabilirmi veya sadece seçsin.

Mesaj Box da Gösterdiğinde renklendirip Tamam dendiğinde Renkler Kalksa daha iyi olur.

Korhan Ayhan · 20 Mart 2011

Selamlar,

Bu işlem için makro kullanmanıza gerek yok. Koşullu biçimlendirme kulanarak hazırladığım örnek dosyayı incelermisiniz.

Uygulanan işlem;

"A-D" sütun aralığı seçilir.
BİÇİM-KOŞULLU BİÇİMLENDİRME menüsü açılır.
İlk koşulda formül seçeneği seçilir ve formül kutusuna aşağıdaki formül uygulanır.

Kod:

=MAK($C:$C)=$C1

Biçim butonuna tıklayarak uygun dolgu rengi seçilir.

Ekle butonuna tıklanır.
İkinci koşul için açılan bölümde formül seçeneği seçilir ve formül kutusuna aşağıdaki formül uygulanır.

Kod:

=MİN($C:$C)=$C1

Biçim butonuna tıklayarak uygun dolgu rengi seçilir ve işlem tamamlanır.

ynmcan · 20 Mart 2011

Syn.1Mak1Mak;
Dosyanız ekte.

Kod:

Private Sub CommandButton1_Click()
Dim vMax, vMin

vMax = WorksheetFunction.Max(Range("C:C"))
vMin = WorksheetFunction.Min(Range("C:C"))

For sat = 1 To 200
       For i = 1 To 4
       Cells(sat, i).Interior.ColorIndex = xlNone
       If Cells(sat, 3) = vMax Then Cells(sat, i).Interior.ColorIndex = 3
       If Cells(sat, 3) = vMin Then Cells(sat, i).Interior.ColorIndex = 4
       Next i
       Next sat

MsgBox "En Büyük Değer " & vMax & vbCrLf & _
       "En Küçük Değer " & vMin, vbInformation, "Max & Min"
       
Range("A1:D200").Interior.ColorIndex = xlNone

End Sub

1mak1mak · 20 Mart 2011

Korhan Ayhan' Alıntı:
Selamlar,

Bu işlem için makro kullanmanıza gerek yok. Koşullu biçimlendirme kulanarak hazırladığım örnek dosyayı incelermisiniz.

Uygulanan işlem;

"A-D" sütun aralığı seçilir.
BİÇİM-KOŞULLU BİÇİMLENDİRME menüsü açılır.
İlk koşulda formül seçeneği seçilir ve formül kutusuna aşağıdaki formül uygulanır.

Kod:

=MAK($C:$C)=$C1

Biçim butonuna tıklayarak uygun dolgu rengi seçilir.

Ekle butonuna tıklanır.
İkinci koşul için açılan bölümde formül seçeneği seçilir ve formül kutusuna aşağıdaki formül uygulanır.

Kod:

=MİN($C:$C)=$C1

Biçim butonuna tıklayarak uygun dolgu rengi seçilir ve işlem tamamlanır.

Sayın Korhan Ayhan,

İlginiz için Teşekkürler yalnız Koşullu biçimlendirmede Kullandığım başka fonksiyonlar var üçüde dolu bu yüzden bu şekilde arıyorum.

1mak1mak · 20 Mart 2011

ynmcany' Alıntı:

Syn.1Mak1Mak;
Dosyanız ekte.

Kod:

Private Sub CommandButton1_Click()
Dim vMax, vMin

vMax = WorksheetFunction.Max(Range("C:C"))
vMin = WorksheetFunction.Min(Range("C:C"))

For sat = 1 To 200
       For i = 1 To 4
       Cells(sat, i).Interior.ColorIndex = xlNone
       If Cells(sat, 3) = vMax Then Cells(sat, i).Interior.ColorIndex = 3
       If Cells(sat, 3) = vMin Then Cells(sat, i).Interior.ColorIndex = 4
       Next i
       Next sat

MsgBox "En Büyük Değer " & vMax & vbCrLf & _
       "En Küçük Değer " & vMin, vbInformation, "Max & Min"
       
Range("A1:D200").Interior.ColorIndex = xlNone

End Sub

Sevgili ynmcany çok Teşekkür ederim istediğim tam buydu.
Ellerine sağlık.

1mak1mak · 8 Nisan 2011

Daha Önce burada derdime çare bulmuştum ancak kullanmaya başlayınca
problem olmaya başladı probleme gelince.
Ekteki dosyadada görüldüğü gibi "En Büyük ve Küçük Değeri" bul dediğimde
Buluyor ve "Mesaj Kutusu" açıyor bu yüzden sayfayı kaydıramıyorum.
Koddan "Mesaj Kutusu" özelliğinide kaldırdığım zaman bul dediğimde buluyor ama
hemen kayboluyor.
Benim istediğim "Mesaj Kutusu" olmasın ama Bul dediğimde işaretledikten sonra başka bir hücreye Tıklayana kadar kalsın yani sayfayı Aşağı Yukarı kaydırıp bakabileyim.

Teşekkürler

Örnek Dosya Ekte

mancubus · 8 Nisan 2011

tam olarak ne istediğinizi anlamadım ama sayfa3'ün kod modülünde yer alan kodu aşağıda yazdığım şekilde düzenlerseniz sayfadaki 3 düğme de yan yana hareket eder. tıklayarak istediğiniz min veya max değerin hücresine gidebilirsiniz.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Column > 250 Then Exit Sub
    
    With ActiveSheet
        .Shapes("CommandButton1").Top = ActiveCell.Offset(0, 1).Rows.Top
        .Shapes("CommandButton1").Left = ActiveCell.Offset(0, 1).Rows.Left
        
        .Shapes("CommandButton2").Top = ActiveCell.Offset(0, 2).Rows.Top
        .Shapes("CommandButton2").Left = ActiveCell.Offset(0, 2).Rows.Left
        
        .Shapes("CommandButton3").Top = ActiveCell.Offset(0, 3).Rows.Top
        .Shapes("CommandButton3").Left = ActiveCell.Offset(0, 3).Rows.Left
    End With

End Sub

1mak1mak · 8 Nisan 2011

mancubus' Alıntı:
tam olarak ne istediğinizi anlamadım ama sayfa3'ün kod modülünde yer alan kodu aşağıda yazdığım şekilde düzenlerseniz sayfadaki 3 düğme de yan yana hareket eder. tıklayarak istediğiniz min veya max değerin hücresine gidebilirsiniz.

Teşekkürler Buda bir Alternatif Ben Kodu ekteki gibi modifiye ettim.
Buda olabilir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column > 250 Then Exit Sub

With ActiveSheet
.Shapes("CommandButton1").Top = ActiveCell.Offset(-1, 2).Rows.Top
.Shapes("CommandButton1").Left = ActiveCell.Offset(0, 2).Rows.Left

.Shapes("CommandButton2").Top = ActiveCell.Offset(-1, 3).Rows.Top
.Shapes("CommandButton2").Left = ActiveCell.Offset(-1, 3).Rows.Left

.Shapes("CommandButton3").Top = ActiveCell.Offset(1, 2).Rows.Top
.Shapes("CommandButton3").Left = ActiveCell.Offset(1, 2).Rows.Left
End With

End Sub

Benim esas istediğim "CommandButton3_Click" Kodundaki "Mesaj Kutusu" kaldırarak
"Satır Renklendirmesi"'nin başka hücreye tıklayana kadar kalıcı olmasıydı.

Buda işimi görür ama bu konuyla ilgili öneriniz olursa başka işlerde bana fikir verir.

ynmcan · 8 Nisan 2011

Syn.1Mak1Mak;
Msbox yerine userform kulanarak bir örnek yaptım.
Açılan Userfor Üzerindeki Büyük ve Küçük değerlerin üzerine tıklayınca, o değerlerin bulunduğu hücre aktif duruma geliyor.
İşinize yararmı bir bakın.
Dosya ekte.

mancubus · 8 Nisan 2011

elimde baz kodlar vardı. sizin duruma uyarladım.
kolay gelsin.

sayfa3'ü kopyalayarak yeni bir sayfa yapın. bu sayfa'nın kod modülüne aşağıdaki kodların tamamını ekleyin. deneyin.

En Büyük düğmesi ile en MAX değeri, En Düşük düğmesi ile MIN değeri, Büyük Küçük düğmesi ile seçime göre MAX veya MIN değeri olan hücreyi seçebileceksiniz.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LR As Long, LC As Long

LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LC = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

If Target.Column > 250 Then Exit Sub
If Target.Row > 65000 Then Exit Sub
If Target.Row < 2 Then Exit Sub

With ActiveSheet
    .Shapes("CommandButton1").Top = ActiveCell.Offset(-1, 2).Rows.Top
    .Shapes("CommandButton1").Left = ActiveCell.Offset(0, 2).Rows.Left
    
    .Shapes("CommandButton2").Top = ActiveCell.Offset(-1, 3).Rows.Top
    .Shapes("CommandButton2").Left = ActiveCell.Offset(-1, 3).Rows.Left
    
    .Shapes("CommandButton3").Top = ActiveCell.Offset(1, 2).Rows.Top
    .Shapes("CommandButton3").Left = ActiveCell.Offset(1, 2).Rows.Left
End With
Range(Cells(1, 1), Cells(LR, LC)).Interior.ColorIndex = xlNone

End Sub

Private Sub CommandButton1_Click()
    
Dim Rng As Range, xRng As Range
Dim xMax As Double

Set Rng = Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row)
xMax = Application.Max(Rng)
Set xRng = Cells.Find(What:=xMax)
xRng.Select
Range("A" & xRng.Row & ":D" & xRng.Row).Interior.ColorIndex = 3
    
End Sub

Private Sub CommandButton2_Click()

Dim Rng As Range, nRng As Range
Dim nMin As Double

Set Rng = Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row)
nMin = Application.Min(Rng)
Set nRng = Cells.Find(What:=nMin)
nRng.Select
Range("A" & nRng.Row & ":D" & nRng.Row).Interior.ColorIndex = 6

End Sub

Private Sub CommandButton3_Click()

Dim cfRng As Range, nRng As Range, xRng As Range
Dim LR As Long, LC As Long
Dim xMax As Double, nMin As Double

LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LC = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

Set cfRng = Range("C3:C" & LR)

With cfRng
    With .FormatConditions
        .Delete
        .Add Type:=xlExpression, Formula1:="=C3>C2"
        .Add Type:=xlExpression, Formula1:="=C3<C2"
        .Add Type:=xlExpression, Formula1:="=C3=C2"
    End With
    .FormatConditions(1).Interior.ColorIndex = 33
    .FormatConditions(2).Interior.ColorIndex = 4
    .FormatConditions(3).Interior.ColorIndex = 6
End With

xMax = Application.Max(cfRng)
nMin = Application.Min(cfRng)

Set xRng = Cells.Find(What:=xMax)
Set nRng = Cells.Find(What:=nMin)

maxmin = MsgBox(Prompt:="Maximum için YES, Minimum için NO, iptal için CANCEL", _
            Buttons:=vbYesNoCancel, Title:="MAX / MIN")

If maxmin = vbYes Then
    xRng.Select
    Range("A" & xRng.Row & ":D" & xRng.Row).Interior.ColorIndex = 3
ElseIf maxmin = vbNo Then
    nRng.Select
    Range("A" & nRng.Row & ":D" & nRng.Row).Interior.ColorIndex = 6
Else
    Exit Sub
End If

End Sub

1mak1mak · 9 Nisan 2011

ynmcany' Alıntı:
Syn.1Mak1Mak;
Msbox yerine userform kulanarak bir örnek yaptım.
Açılan Userfor Üzerindeki Büyük ve Küçük değerlerin üzerine tıklayınca, o değerlerin bulunduğu hücre aktif duruma geliyor.
İşinize yararmı bir bakın.
Dosya ekte.

Teşekkürler Sevgili ynmcany,

Verdiğin örnek dosya işimi gördü. Hemde çok şık olmuş.
Diğer sonra verdiğin kodu denedim o kadar kullanışlı gelmedi.

Tekrar ilgin için çok Teşekkürler

Demet2000 · 20 Nisan 2011

Merhaba,
Eklentilerinizi gördüm.Bende sizden yardım alabilirmiyim?
Sormak istediğim;
En yüksek rakamı satır bazında bulabilirmi?Yanı,Örneğin 3.satırda yanyana hücrelerde yazılı sayıların en büyüğünü buluk renklendirebilir mi?

Yardımlarınız için şimdiden teşekkür ederim..

Demet2000 · 21 Nisan 2011

Bana yardım etmeyecekmisiniz(((((

mancubus · 21 Nisan 2011

benim yazdığım cevaba soru sahibi dönüş yapmadığı için işine yarayıp yaramadığını öğrenemedim.

örnek dosya eklemeniz daha fazla yardımcı olurdu.

ama 3. satır için aşağıdaki gibi deneyebilirsiniz.

Kod:

Sub sat_maks_bul()

Dim xRng As Range
Dim xMax As Double

xMax = Application.Max(Rows(3)) 
Set xRng = Cells.Find(What:=xMax)
xRng.Interior.ColorIndex = 3

End Sub

5. satır için 3'ü silip 5 yazın

Demet2000 · 26 Nisan 2011

Öncelikle çok teşekkür ederim,yardımların için.

Dediğin gibi yaptım.Sanırım dediğin gibi örnek dosya göndersem daha iyi olcaktı

Sayfadaki tüm satılar için nasıl yapabilirim?
Örnek dosyayı ekledim.

Çok teşekkür ederim...

maximillien · 5 Ekim 2011

maksimum değerin olduğu sütun değerlerini çağırma

açıklamaya çalışayım max mutlak M3 değerine karşılık gelen P değerini diğer sayfaya yazdırmak istiyorum ve maximum P değerine karşılık gelen M3 değerini

oneycetin · 21 Mart 2014

ekleri nasıl indirebiliriz? teşekkürler

En Büyük ve Küçük Değeri Bul Dolu Satırları İşaretle

1mak1mak

Ekli dosyalar

ynmcan

Ekli dosyalar

1mak1mak

Korhan Ayhan

Administrator

Ekli dosyalar

ynmcan

Ekli dosyalar

1mak1mak

1mak1mak

1mak1mak

Ekli dosyalar

mancubus

Destek Ekibi

1mak1mak

ynmcan

Ekli dosyalar

mancubus

Destek Ekibi

1mak1mak

Demet2000

Demet2000

mancubus

Destek Ekibi

Demet2000

Ekli dosyalar

maximillien

Ekli dosyalar

oneycetin