Listview arama

[ragnorak]

Listview üzerinde resimdeki gibi tablom var. Bu tabloda seçim yaptığım zaman satırdaki en büyük ve en küçük değeri bulmak istiyorum. örneğin 14.nolu satırı seçtiğimde en küçük TEX 140,79 en büyük CEVA 465,49 şeklinde

 

[muhasebeciyiz]

Alt + F11 → VBA editörünü aç
Sol tarafta çalışma sayfanı seç (örneğin “Sayfa1 (Sheet1)”)
Kod penceresine şunu yapıştır:

Eğer satır seçildiğinde (örneğin tıkladığında) otomatik bulsun istiyorsan bu kısa makroyu kullanabilirsin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim minVal As Double, maxVal As Double
    Dim minCol As String, maxCol As String
    Dim rng As Range, c As Range

    ' Sadece tek satır seçiliyse çalışsın
    If Target.Rows.Count = 1 Then
        Set rng = Intersect(Target.EntireRow, Range("B:J")) ' Değerlerin olduğu sütun aralığı

        If Not rng Is Nothing Then
            minVal = Application.Min(rng)
            maxVal = Application.Max(rng)

            For Each c In rng
                If c.Value = minVal Then minCol = Cells(1, c.Column).Value
                If c.Value = maxVal Then maxCol = Cells(1, c.Column).Value
            Next c

            MsgBox "En küçük: " & minCol & " = " & Format(minVal, "0.00") & vbCrLf & _
                   "En büyük: " & maxCol & " = " & Format(maxVal, "0.00"), vbInformation, "Sonuç"
        End If
    End If
End Sub

Çalışma sayfasında herhangi bir satıra tıklarsan,
o satırın B:J aralığındaki en küçük ve en büyük değerlerini gösterir.

 

[Muzaffer Ali]

Merhaba.
Sayfada değil ListView üzerindeki seçim demiş.

Aşağıdaki kodu formun kod sayfasına kopyalayın.
ListViewe çift tıkladığınızda TextBox1'e en küçük TextBox2'ye en büyük değeri yazar.

Private Sub ListView1_DblClick()
    Dim Bak As Integer
    Dim EnBuyuk As Double
    Dim EnKucuk As Double
    
    With ListView1.SelectedItem
        EnBuyuk = .SubItems(1)
        EnKucuk = .SubItems(1)
        For Bak = 1 To ListView1.ColumnHeaders.Count - 1
            If EnBuyuk < .SubItems(Bak) Then
                EnBuyuk = .SubItems(Bak)
            End If
            If EnKucuk > .SubItems(Bak) Then
                EnKucuk = .SubItems(Bak)
            End If
        Next
    End With
    TextBox1.Text = EnKucuk
    TextBox2.Text = EnBuyuk
End Sub

 

[ragnorak]

@Muzaffer Ali kod için teşekkür ederim. Değerleri buluyor. hangi kargo şirketine ait olduğunu da yazabilir miyiz? Birde satırda boş değer varsa hataya düşüyor.

 

[Ouzz_z]

En küçük olan için ayrı bi sütun açıp oraya yazsanız her tıkladığınızda sürekli çalışmasa daha iyi olur

 

[Muzaffer Ali]

@Muzaffer Ali kod için teşekkür ederim. Değerleri buluyor. hangi kargo şirketine ait olduğunu da yazabilir miyiz? Birde satırda boş değer varsa hataya düşüyor.

Private Sub ListView1_DblClick()
    Dim Bak As Integer
    Dim EnBuyuk As Double
    Dim EnKucuk As Double
    Dim KargoKucuk As String
    Dim KargoBuyuk As String
    
    With ListView1.SelectedItem
        EnBuyuk = .SubItems(1)
        EnKucuk = .SubItems(1)
        For Bak = 1 To ListView1.ColumnHeaders.Count - 1
            If EnBuyuk < .SubItems(Bak) Then
                EnBuyuk = .SubItems(Bak)
                KargoBuyuk = ListView1.ColumnHeaders(Bak + 1).Text
            End If
            If EnKucuk > .SubItems(Bak) Then
                EnKucuk = .SubItems(Bak)
                KargoKucuk = ListView1.ColumnHeaders(Bak + 1).Text
            End If
        Next
    End With
    TextBox1.Text = EnKucuk
    TextBox2.Text = EnBuyuk
    TextBox3.Text = KargoKucuk
    TextBox4.Text = KargoBuyuk
End Sub

 

[ragnorak]

 Dim Bak As Integer
    Dim EnBuyuk As Double
    Dim EnKucuk As Double
    Dim KargoKucuk As String
    Dim KargoBuyuk As String
    
    With ListView1.SelectedItem
        EnBuyuk = 1
        EnKucuk = 250000
        For Bak = 1 To ListView1.ColumnHeaders.count - 1
        
If .SubItems(Bak) = "" Then: GoTo devam
        
            If EnBuyuk < .SubItems(Bak) Then
                EnBuyuk = .SubItems(Bak)
                KargoBuyuk = ListView1.ColumnHeaders(Bak + 1).text
            End If

            If EnKucuk > .SubItems(Bak) Then
                EnKucuk = .SubItems(Bak)
                KargoKucuk = ListView1.ColumnHeaders(Bak + 1).text
            End If
devam:
        Next
    End With
    StatusBar1.Panels.Item(1) = "En Düşük : " & KargoKucuk & "  " & EnKucuk
    StatusBar1.Panels.Item(2) = "En Yüksek : " & KargoBuyuk & "  " & EnBuyuk

@Muzaffer Ali boş satırlarda hata verdiğinden bu şekilde revize ettim. Birde EnBuyuk = .SubItems(1) şeklinde yazınca bu sutundaki başlık (ARAS) görünmüyor, Sadece değeri veriyor! Sebebini anlamadım. Çok teşekkür ederim.

 

[Muzaffer Ali]

Aşağıdaki kodu deneyin.
Eğer düzelmezse dosyanızı ekleyin kontrol edeyim.

Private Sub ListView1_DblClick()
    Dim Bak As Integer
    Dim EnBuyuk As Double
    Dim EnKucuk As Double
    Dim KargoKucuk As String
    Dim KargoBuyuk As String
    
    With ListView1.SelectedItem
        EnBuyuk = .SubItems(1) - 1
        EnKucuk = .SubItems(1) + 1
        For Bak = 1 To ListView1.ColumnHeaders.Count - 1
            If EnBuyuk < .SubItems(Bak) Then
                EnBuyuk = .SubItems(Bak)
                KargoBuyuk = ListView1.ColumnHeaders(Bak + 1).Text
            End If
            If EnKucuk > .SubItems(Bak) Then
                EnKucuk = .SubItems(Bak)
                KargoKucuk = ListView1.ColumnHeaders(Bak + 1).Text
            End If
        Next
    End With
    StatusBar1.Panels.Item(1) = "En Düşük : " & KargoKucuk & "  " & EnKucuk
    StatusBar1.Panels.Item(2) = "En Yüksek : " & KargoBuyuk & "  " & EnBuyuk
End Sub

 

[ragnorak]

Bu şekilde gayet güzel çalışıyor. Elinize emeğinize sağlık. Teşekkür ederim.