Soru En Yüksek ve En Düşük Değerleri Listeleme

[dengeceteris]

Herkese iyi günler dilerim..

Bir kaç hafta önce yine yüklemiştim dosyayı ama ilgilenen arkadaşların önerileri bir sonuç vermemişti daha sonra yazmama rağmen geri dönüşte alamayınca tekrar yeni konu açmak zorunda kaldım. Yardımcı olan olursa sevinirim. (Bana yazılanların detayları bir önceki konu başlığında vardı)

Her sütunda en yüksek 10 değeri mesela yeşil renge sonra ki gelen en yüksek 10 değeri farklı bir renge boyamak ve renge göre gelişmiş filtreleme yapmak istiyorum

Saygılarımla

 

[uzmanamele]

Merhaba
542 satır, 101 sütunluk örnek dosya olmaz.
En fazla 20x10 boyutunda örnek tablo oluşturup görmek istediğiniz sonucu tablo üzerinde manuel yazarak yardım isteyiniz.
Kimse sizin ne yaptığınızla ilgilenmez, sonunuza yardımcı olmakla ilgilenir.

 

[dengeceteris]

Sayın uzmanamele: haklısınız ben daha konsantre bir hale getirdim. İstediğim filtrelemenin sağlıklı çalışması çok mümkün olmayacağı içinde istediğim veriyi biraz daha basitleştirdim. Tablo içinde notumu anlattım.

 

[Erkan Akayay]

Bu söylediğiniz koşullu biçimlendirme ile yapılabilir.

 

[Erkan Akayay]

Buda renklendirme için kodlu çözüm olsun.

Sub Renklendir()
Dim rng As Range, target As Range, lrow As Long, lcol As Integer
topN = 10
lrow = Cells(Rows.count, 1).End(3).Row
lcol = Cells(6, Columns.count).End(1).Column
    For i = 1 To lcol
        Set target = Range(Cells(7, i), Cells(Cells(Rows.count, 1).End(3).Row, i))
        For Each rng In target
            For j = 1 To topN
                If rng.Value = WorksheetFunction.Large(target, j) Then
                    rng.Interior.Color = vbGreen
                End If
            Next j
        Next rng
    Next i
End Sub

 

[Erkan Akayay]

Aynı kodda en büyük 10 değer yeşil, en küçük 10 değer sarı

Sub Renklendir()
Dim rng As Range, target As Range, lRow As Long, lCol As Integer
maxMin = 10
lRow = Cells(Rows.Count, 1).End(3).Row
lCol = Cells(6, Columns.Count).End(1).Column
    For i = 1 To lCol
        Set target = Range(Cells(7, i), Cells(Cells(Rows.Count, 1).End(3).Row, i))
        For Each rng In target
            For j = 1 To maxMin
                If rng.Value = WorksheetFunction.Large(target, j) Then
                    rng.Interior.Color = vbGreen
                ElseIf rng.Value = WorksheetFunction.Small(target, j) Then
                    rng.Interior.Color = vbYellow
                End If
            Next j
        Next rng
    Next i
End Sub

 

[dengeceteris]

Sevgili Erkan bey merhabalar.. ilgi ve alakanız için tşk ederim. Bu sayfaya veriler makro ile veri çekme şeklinde geliyor ve nedense formüller yaptığım koşullu biçimlendirme siliniyor. Onun için bir kod rica ettim. İlk sıradaki formül işimi görüyor. sizden ricam. Bu taslak olduğu için asıl verim daha büyük. Biz hesaplamayı A sütunundan başlatmıştık. Hesaplamamı (A ve B tanımlar olduğu için) C7:CW600 olacak şekilde ayarlayabilir miyiz. İkinci formül yeşilleri buluyor doğru bir şekilde ama en düşük değerleri bulurken sadece -1 olanları sarıya boyuyor.

 

[Erkan Akayay]

C den başlatmak için
For i = 1 To lCol (1 ile 1. sütun anlatılıyor)
satırını
For i = 3 To lCol
olarak değiştirin.

ama en düşük değerleri bulurken sadece -1 olanları sarıya boyuyor. demişsiniz.
En düşük 10 değer içinde -1 olduğu için -1'leri işaretliyor. Sadece _1 leri değil.
En küçük 10 değer içinde aynı sayılar birden fazla varsa hepsi en küçük 10 içinde.
-1 en küçük 10 içindeyse kaç kere varsa işaretlenir.
Tekrarlayan sayılar varsa 10 dan fazla sarı görebilirsiniz.

 

[excelokyanus500]

Sayfa adınızı güncelleyin.

Dikkat bu makro ilgili alanı sort yaparak hücrelerin yerini değiştirir. Size uygunsa kullanınız.

Not: Dosyanıza bakma imkanım yok.


Sub UygulaRangeC7CW600()

Dim ws As Worksheet
Dim veriAraligi As Range

' Çalışma sayfasını belirle
Set ws = Sheets("Sayfa1") ' Sayfa adını güncelleyin

' Veri aralığını belirle
Set veriAraligi = ws.Range("C7:CW600")


SıralaVeRenklendir2 ws, veriAraligi
MsgBox ("İşlem tamam")
End Sub

Sub SıralaVeRenklendir2(ws As Worksheet, veriAraligi As Range)
On Error GoTo x
Dim lastRow As Long
Dim lastCol As Long
Dim renk As Long
Dim col As Long
Dim row As Long
Set ws = Sheets("Sayfa1")
' Satır ve sütun sayılarını belirle
' lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
'lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

' Veri aralığını güncelle
Set veriAraligi = ws.Range("C7:CW600")
lastRow = veriAraligi.Rows.Count + veriAraligi.row - 1
lastCol = veriAraligi.Columns.Count + veriAraligi.Column - 1
' Son sütunu küçükten büyüğe sırala



For s = 3 To lastCol
For k = 7 To lastRow
ws.Cells(k, s).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add2 Key:=Cells(k, s), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").Sort
.SetRange Selection
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



' Renklendirme işlemi
renk = RandomRenk()
For row = 2 To lastRow
If row Mod 20 = 0 Then
renk = RandomRenk()
End If
For c = 1 To lastCol - 2
veriAraligi.Cells(row, c).Interior.Color = renk
Next

Next row
Exit For
Next

Next
x:
Exit Sub
End Sub

Function RandomRenk() As Long

Dim kirmizi As Integer
Dim yesil As Integer
Dim mavi As Integer

kirmizi = Int((256 * Rnd()))
yesil = Int((256 * Rnd()))
mavi = Int((256 * Rnd()))

RandomRenk = RGB(kirmizi, yesil, mavi)
End Function

 

[dengeceteris]

C den başlatmak için
For i = 1 To lCol (1 ile 1. sütun anlatılıyor)
satırını
For i = 3 To lCol
olarak değiştirin.

ama en düşük değerleri bulurken sadece -1 olanları sarıya boyuyor. demişsiniz.
En düşük 10 değer içinde -1 olduğu için -1'leri işaretliyor. Sadece _1 leri değil.
En küçük 10 değer içinde aynı sayılar birden fazla varsa hepsi en küçük 10 içinde.
-1 en küçük 10 içindeyse kaç kere varsa işaretlenir.
Tekrarlayan sayılar varsa 10 dan fazla sarı görebilirsiniz.

Ekli dosyayı görüntüle 248716

Hocam gerekli düzeltmeleri uyguladım. sorunsuz çalışıyor. Çok tşk ederim