Değeri en yüksek olan 5 ayrı rakamın renkinin yanım sönmesi

[danke]

Arkadaşlar kolay gelsin;
Excell 2003 ve 2007 kullanıyorum (2 ayrı bilgisayar). Excell belgemde bir sütünda olması gereken değerler, her hücrenin bulunduğu satırdaki dolu değerleri toplamak suretiyle değiştiriyor. Yani o sütündaki değerler satırdaki değerler değiştikçe kendiliğinden değişiyor.
Benim istediğim ise o sütünda bulunan rakamlardan en küçük (7 tanesi)nin arka plan renklerinin yanıp sönmesi.
Tabi bu sütunda bulunan rakamlardan en küçük olanlar hep aynı hücreler değil, o satırlardaki dolu olanlar değiştikçe sütunlardakilerde değişiyor.

Arkadaşlar bunu istememeni sebebi ise şu; sıra takibi gereken bir istatistikte sırası gelenleri hemen fark etmek.

İlgilenip cevap veren arkadaşlara şimdiden çok teşekkürler.

 

[Ferhat Pazarçevirdi]

Gerçi başlıkla, içerik birbirinin tamamen zıttı olmuş ama, ben mesaj içeriğinde istediğiniz şeyin doğru olduğunu kabul ederek, C sütunundaki en küçük 7 değerin yanıp sönmesini ayarladım.

Kodlar şu şekilde dizayn edildi. Eğer kodları kopyalama usulü kullanacaksanız, VBA projenize; Microsoft Activex Data Objects Recordset X.X Library referansını ekleyiniz.

Standart bir Modul sayfasına :

Public bDurdur As Boolean
Dim rng As Range
'-----------------------
Sub Durdur()
    bDurdur = True
    Set rng = Range("C5:C" & Cells(65536, 3).End(xlUp).Row)
    rng.Interior.Color = vbYellow
    rng.Font.Color = vbRed
    Set rng = Nothing
End Sub
 
'--------------------
Sub Basla()
    Dim rs As ADOR.Recordset
    Dim i As Integer
    Dim x As Integer
    Dim dTimer As Double
    Dim bRenk As Boolean
 
    bDurdur = False
    Set rs = New ADOR.Recordset
 
    With rs
        With .Fields
            .Append "No", adDouble
            .Append "Satir", adDouble
        End With
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .Open
 
        For i = 5 To Cells(65536, 3).End(xlUp).Row
            If Len(Cells(i, 3)) > 0 Then
                If IsNumeric(Cells(i, 3)) Then
                    .AddNew "No", Cells(i, 3)
                    rs(1) = i
                End If
            End If
        Next i
        .Sort = "No"
    End With
 
    Do While x < 7
        x = x + 1
        If x = 1 Then
            Set rng = Cells(rs(1), 3)
        Else
            Set rng = Application.Union(rng, Cells(rs(1), 3))
        End If
        rs.MoveNext
    Loop
 
    DoEvents
 
    Do While bDurdur = False
        With rng
            If bRenk Then
                .Interior.Color = vbRed
                .Font.Color = vbYellow
            Else
                .Interior.Color = vbYellow
                .Font.Color = vbRed
            End If
        End With
 
        bRenk = Not bRenk
 
        dTimer = Timer
        Do: DoEvents: Loop While Timer - dTimer < 0.5
    Loop
 
    Set rs = Nothing
 
End Sub

Olayların yaşandığı Worksheet kod modülüne;

Private Sub Worksheet_Activate()
    Call Durdur: Call Basla
End Sub
'------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    Call Durdur: Call Basla
End Sub
'------------------------
Private Sub Worksheet_Deactivate()
    bDurdur = True
End Sub

ve son olarak ThisworkBook kod modülüne ...

Private Sub Workbook_Activate()
    If ActiveSheet.Name = "Sayfa1" Then
        Call Basla
    End If
End Sub
'---------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    bDurdur = True
End Sub
'---------------
Private Sub Workbook_Deactivate()
    bDurdur = True
End Sub

Örnek dosyayı inceleyiniz.

 

[danke]

Ferhat Pazarçevirdi teşekkür ediyorum ilgilenip cevap verdiğin için, ancak verdiğin örneği kendi belgeme uygulamayamadım. Onun için belgeyi ekte gönderdim. Birde en az (7) değilde (10) olsa zor olur mu?

İsimlerin bulunduğu alan değişik zamanlarda değişebilir, yani bazen isimler silinecek, bazen yeni isimler eklenebilecek... böyle olması uygulamayı etkiler mi?

Gönderdiğim çizelgede maksadım, anahtar harflerle (sol tarafta a sütununda bulunan) kişilere yazılan nöbetlerin sayılması, aslında buda işimi görüyor ama dikkatten kaçan olmasın diye en az (10)'u öğrenmek istedik. Böylece hem itirazların önüne geçmiş olacağız, hem adaleti sağlamış olacağız. Başkaca eklenmesi uygun olan birşey var da derseniz tekliflere açığım.

İnternet bilgisayarının başında bulunmadığım için cevabı biraz geç verdim, ilginiz için şimdiden teşekkürler.

 

[Ferhat Pazarçevirdi]

Birde en az (7) değilde (10) olsa zor olur mu?

Olmaz ...

İsimlerin bulunduğu alan değişik zamanlarda değişebilir, yani bazen isimler silinecek, bazen yeni isimler eklenebilecek... böyle olması uygulamayı etkiler mi?

Etkilemez ...

Ekte; kodları orjinal dosyanıza uyarladım. İnceleyiniz.

 

[danke]

teşekkür ediyorum ilginiz için kolay gelsin..