Listview satırındaki max. ve min. sayıyı bulmak

[mehmet dur]

Merhabalar 24 sütun ve 1 satırdan oluşan listview'de en büyük ve en küçük sayıyı bulup renklendirmek istiyorum. Yardımlarınız için şimdiden teşekkür ederim.

 

[Orion1]

Listviewde Hücre rengi renklendirilemez.
Ancak Fontlar renklendirilebilir.
İstediğiniz sütunu sıralama kodunu yazarak en büyük ve en küçük sayıyı bulabilirsiniz.
Forumda bu öreneklerden çokça var,Arama yaparak bulabilirsiniz.

 

[mehmet dur]

Merhaba Orion1
Cevabınız için teşekkür ederim. Sorumda belki tam açıklayamadım ama benim istediğim sütunu değil, listview'im tek satır olduğu için satırdaki verilerin en büyük ve en küçüğünü bulup renklendirmek istiyorum. Tabi hücre rengini değil, fontlarını renklendirmek istiyorum.

 

[ÖmerFaruk]

ListView nesnesinde satır yazı rengi değişir ama tek bir hücrenin değil. Komple satırın.

 

[Orion1]

Veriyi listviewe alırken,veriyi aldığı sündaki verileri ayni satırda min ve max yerleşik fonksiyonlarını kullanarak verileri alabilirsiniz.

 

[Korhan Ayhan]

Uzun zamandır ListView kullanmıyordum.

Antrenman olsun diye bir dosya hazırladım. Sanırım kendinize uyarlayabilirsiniz.

Harici Link (Silinebilir) ; https://dosyam.org/1ObC/ListView_Renk_Uygulaması.xlsm

 

[mehmet dur]

Merhaba Korhan Bey
Mesajınıza (Elde olmayan sebeblerden dolayı) ancak cevap yazıyorum, kusura bakmayın. Dosyanızı indiremedim hata veriyor, indirme olmadan form üzerinden yazabilir misiniz? Teşekkür ederim.

 

[Korhan Ayhan]

Kullandığım kodlar;

Option Explicit

Private Sub CommandButton1_Click()
    Dim WF As WorksheetFunction, X As Integer, En_Kucuk As Double, En_Buyuk As Double
    
    Set WF = WorksheetFunction
    
    ReDim Liste(23)
    
    With ListView1
        Liste(0) = CLng(.ListItems(1))
        
        For X = 1 To 23
            Liste(X) = CLng(.ListItems(1).ListSubItems(X))
        Next
        
        En_Kucuk = WF.Min(Liste)
        En_Buyuk = WF.Max(Liste)
    
        If CLng(.ListItems(1)) = En_Kucuk Or CLng(.ListItems(1)) = En_Buyuk Then
            .ListItems(1).ForeColor = vbRed
            .ListItems(1).Bold = True
        End If
        For X = 1 To 23
            If CLng(.ListItems(1).ListSubItems(X)) = En_Kucuk Or CLng(.ListItems(1).ListSubItems(X)) = En_Buyuk Then
                .ListItems(1).ListSubItems(X).ForeColor = vbRed
                .ListItems(1).ListSubItems(X).Bold = True
            End If
        Next
        
        .Refresh
    End With
End Sub

Private Sub CommandButton2_Click()
    UserForm_Activate
End Sub

Private Sub UserForm_Activate()
    Dim WF As WorksheetFunction, X As Integer
    
    Set WF = WorksheetFunction
    
    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        .BackColor = vbWhite
        
        With .ColumnHeaders
            For X = 1 To 24
                .Add , , "SAYI-" & X, 40
            Next
        End With
        
        .ListItems.Add , , WF.RandBetween(1, 1000)
        
        For X = 1 To 23
            .ListItems(1).SubItems(X) = WF.RandBetween(1, 1000)
        Next
    End With
End Sub

 

[mehmet dur]

Korhan bey "Liste(0) = CLng(.ListItems(1))" bu satırda hata veriyor. Benim .ListItems(1) sütunum rakam olmadığı için 1'i 2 yaptım yine olmadı.
Index out of bounds (35600) hatasını veriyor.

 

[Korhan Ayhan]

Çalışan dosyayı indirebileceğiniz link varsa paylaşabilirim.

 

[mehmet dur]

Korhan bey 1. sütundaki harfi kaldırınca vermiş olduğunuz kodlar çalıştı. Biraz üzerinde uğraşayım belki onuda yapabilirim. Bu şekilde olması dahi işimi görüyor. Çok teşekkür ederim.

 

[mehmet dur]

Harf olan satırı da hallettim.Çok teşekkürler. Kendime göre düzelttiğim kodlar aşağıda, belki ihtiyacı olan arkadaşlar varsa kullansınlar.

Private Sub CommandButton1_Click()
Dim WF As WorksheetFunction, X As Integer, En_Kucuk As Double, En_Buyuk As Double
Set WF = WorksheetFunction
ReDim Liste(23)
With ListView2
Liste(0) = CLng(.ListItems(1).ListSubItems(1))
For X = 1 To 23
Liste(X) = CLng(.ListItems(1).ListSubItems(X))
Next
En_Kucuk = WF.Min(Liste)
En_Buyuk = WF.Max(Liste)
If CLng(.ListItems(1).ListSubItems(1)) = En_Kucuk Or CLng(.ListItems(1).ListSubItems(1)) = En_Buyuk Then
.ListItems(1).ListSubItems(1).ForeColor = vbRed
.ListItems(1).ListSubItems(1).Bold = True
End If
or X = 1 To 23
If CLng(.ListItems(1).ListSubItems(X)) = En_Kucuk Or CLng(.ListItems(1).ListSubItems(X)) = En_Buyuk Then
.ListItems(1).ListSubItems(X).ForeColor = vbRed
.ListItems(1).ListSubItems(X).Bold = True
End If
Next
.Refresh
End With
End Sub

 

[mehmet dur]

Korhan Bey biraz keyfe keder olacak ama 24 sütunluk veriyi tek seferde değilde 6 Parçaya ayırarak yapsak, yani 1 to 4 - 5 to 8 .... şeklinde kontrol etse ve büyük olanları kırmızı, küçük olanları yeşil renk yapabiilir miyiz?
Not: İsim yazmamın sebebi, soruma Korhan bey'in kodları ile devam ettiğim için. Diğer arkadaşların da cevabı varsa şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim WF As WorksheetFunction, X As Integer
    Dim Y As Integer, Z As Integer, Say As Byte
    Dim En_Kucuk As Double, En_Buyuk As Double
    
    Set WF = WorksheetFunction
    
    With ListView1
        For X = 0 To 23 Step 4
            ReDim Liste(3)
            Say = 0
            
            For Y = X To X + 3
                If Y = 0 Then
                    Liste(0) = CLng(.ListItems(1))
                Else
                    Liste(Say) = CLng(.ListItems(1).ListSubItems(Y))
                End If
                Say = Say + 1
            Next
            
            En_Kucuk = WF.Min(Liste)
            En_Buyuk = WF.Max(Liste)
        
            For Z = X To X + 3
                If Z = 0 Then
                    If CLng(.ListItems(1)) = En_Kucuk Or CLng(.ListItems(1)) = En_Buyuk Then
                        .ListItems(1).ForeColor = vbRed
                        .ListItems(1).Bold = True
                    End If
                Else
                    If CLng(.ListItems(1).ListSubItems(Z)) = En_Kucuk Or CLng(.ListItems(1).ListSubItems(Z)) = En_Buyuk Then
                        .ListItems(1).ListSubItems(Z).ForeColor = vbRed
                        .ListItems(1).ListSubItems(Z).Bold = True
                    End If
                End If
            Next
        Next
        
        .Refresh
    End With
End Sub

 

[mehmet dur]

Teşekkürler Korhan bey elinize, emeğinize sağlık. Bilgi edinmek adına bir sorum var. Bu Step kısmını aynı oranda artan değilde, karışık artma şeklinde de kullanabilir miyiz?

 

[Korhan Ayhan]

Hayır kullanamazsınız..

 

[mehmet dur]

Tamam teşekkürler
Hayırlı Akşamlar