Listview de arama kodlarında düzenleme.

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Merhabalar,listview de kullandığım arama kodlarında küçük bir düzeltme gerekiyor sanırım.Örneklerden bakarak kendime uyarlamaya çalıştım tekxtbox a yazdığım değere göre listeleme yapıyor fakat listede textboxa yazdığım harf geçen bütün verileri listeliyor.Mesela,textbox a "H" yazdım diyelim,listview de içinde H olan bütün verileri sıralıyor. H yazdı isem listede sadece H ile başlayan veriler listelense yani ilk harfden başlayarak listemele yapmak amacım...Textbox kodlarım söyle;
Kod:
Private Sub TextBox1_Change()
 ListView2.ListItems.Clear
    On Error Resume Next
    
        evn = UCase(Replace(Replace(TextBox1, "?", "I"), "i", "I."))
        
        For i = 2 To Sayfa176.Range("a65536").End(3).Row
            If UCase(Replace(Replace(Sheets("met").Cells(i, 3).Value, "?", "I"), "i", "I.")) _
                Like "*" & evn & "*" Then 'Harflerin Büyük veya Küçük ayrım yapılmaksızın _
        aranması için burada UCase ile harfler büyütülüyor
        With Sayfa176
                Set liste = ListView2.ListItems.Add(, , .Cells(i, 1).Value)
                  liste.SubItems(1) = .Cells(i, 2).Value
                  liste.SubItems(2) = .Cells(i, 3).Value
                  liste.SubItems(3) = .Cells(i, 4).Value
                  liste.SubItems(4) = .Cells(i, 5).Value
                  liste.SubItems(5) = .Cells(i, 6).Value
                  liste.SubItems(6) = .Cells(i, 7).Value
                  liste.SubItems(7) = .Cells(i, 8).Value
                  liste.SubItems(8) = .Cells(i, 9).Value
                  liste.SubItems(9) = .Cells(i, 10).Value
                  liste.SubItems(10) = .Cells(i, 11).Value
                  liste.SubItems(11) = .Cells(i, 12).Value
                  liste.SubItems(12) = .Cells(i, 13).Value
                  liste.SubItems(13) = .Cells(i, 14).Value
                liste.SubItems(14) = .Cells(i, 15).Value
                liste.SubItems(15) = .Cells(i, 16).Value
                liste.SubItems(16) = .Cells(i, 17).Value
                liste.SubItems(17) = .Cells(i, 18).Value
                End With
            End If
        Next i
End Sub
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Kod:
Like "*" & evn & "*"
Satırını aşağıdaki şekilde yapın


Kod:
Like evn & "*"
 

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Sayın Dalgalıkur,ilginize çok teşekkür ederim.Tamamdır,tam istediğim gibi oldu çok teşekkür ederim.İyi çalışmalar.:)
 

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Merhabalar tekrar,yeniden konu açmak istemediğimden buradan yazmak istedim..Sayın dalgalıkur 1 nolu mesajımdaki sorunumu saolsun çözmüştü.Fakat kullanırken çeşitli eksiklikler doğunca yeniden küçük düzenlemeler gerekiyor:-( Şöyle ki ; listview kodlarım,
Kod:
Private Sub UserForm_Initialize()
ListView2.View = lvwReport
ListView2.Gridlines = True
ListView2.FullRowSelect = True
ListView2.ColumnHeaders.Clear
    With ListView2.ColumnHeaders
            .Add , , "Sıra No"      'Satır Başlığı,genişlik
            .Add , , "prtkl No"
            .Add , , "ADI "
            .Add , , "DEKONT"
            .Add , , "SONUC DRM"
            .Add , , "LAB BLM"
            .Add , , "NUM.CINSI"
            .Add , , "TETKIK"
            .Add , , "DOKTOR"
            .Add , , "TEL"
            .Add , , "MAIL"
            .Add , , "CINSYT"
            .Add , , "D.TARIH"
            .Add , , "KILO"
            .Add , , "DMSA"
            .Add , , "SAAT"
            .Add , , "ADRES"
            .Add , , "AÇIKLAMA"
        End With
        
         ListView2.ListItems.Clear
    On Error Resume Next
    With Sayfa176
        For i = 2 To .Range("a65536").End(3).Row
        Set liste = ListView2.ListItems.Add(, , .Cells(i, 1).Value)
        liste.SubItems(1) = .Cells(i, 2).Value
        liste.SubItems(2) = .Cells(i, 3).Value
        liste.SubItems(3) = .Cells(i, 4).Value
        liste.SubItems(4) = .Cells(i, 5).Value
        liste.SubItems(5) = .Cells(i, 6).Value
        liste.SubItems(6) = .Cells(i, 7).Value
        liste.SubItems(7) = .Cells(i, 8).Value
        liste.SubItems(8) = .Cells(i, 9).Value
        liste.SubItems(9) = .Cells(i, 10).Value
        liste.SubItems(10) = .Cells(i, 11).Value
        liste.SubItems(11) = .Cells(i, 12).Value
        liste.SubItems(12) = .Cells(i, 13).Value
        liste.SubItems(13) = .Cells(i, 14).Value
        liste.SubItems(14) = .Cells(i, 15).Value
        liste.SubItems(15) = .Cells(i, 16).Value
        liste.SubItems(16) = .Cells(i, 17).Value
        liste.SubItems(17) = .Cells(i, 18).Value
        If UCase(Sheets("met").Cells(i, 5).Value) = "TEKRAR" Then
            ListView2.ListItems(i - 1).ForeColor = vbGreen
            For j = 1 To 17
                ListView2.ListItems(i - 1).ListSubItems(j).ForeColor = vbGreen
            Next
        End If
        If Sheets("met").Cells(i, 4).Value = "YOK" Then
            ListView2.ListItems(i - 1).ListSubItems(3).ForeColor = vbRed
        End If
        Next i
        End With
        ListView2.ListItems(ListView2.ListItems.Count).Selected = True
ListView2.ListItems(ListView2.ListItems.Count).EnsureVisible
End Sub
Bunlarda texbox 1 ile arama yaptığım kodlarım,
Kod:
Private Sub TextBox1_Change()
 ListView2.ListItems.Clear
    On Error Resume Next
    
        evn = UCase(Replace(Replace(TextBox1, "?", "I"), "i", "I."))
        
        For i = 2 To Sayfa176.Range("a65536").End(3).Row
            If UCase(Replace(Replace(Sheets("met").Cells(i, 3).Value, "?", "I"), "i", "I.")) _
                Like evn & "*" Then 'Harflerin Büyük veya Küçük ayrım yapılmaksızın _
        aranması için burada UCase ile harfler büyütülüyor
        With Sayfa176
                Set liste = ListView2.ListItems.Add(, , .Cells(i, 1).Value)
                  liste.SubItems(1) = .Cells(i, 2).Value
                  liste.SubItems(2) = .Cells(i, 3).Value
                  liste.SubItems(3) = .Cells(i, 4).Value
                  liste.SubItems(4) = .Cells(i, 5).Value
                  liste.SubItems(5) = .Cells(i, 6).Value
                  liste.SubItems(6) = .Cells(i, 7).Value
                  liste.SubItems(7) = .Cells(i, 8).Value
                  liste.SubItems(8) = .Cells(i, 9).Value
                  liste.SubItems(9) = .Cells(i, 10).Value
                  liste.SubItems(10) = .Cells(i, 11).Value
                  liste.SubItems(11) = .Cells(i, 12).Value
                  liste.SubItems(12) = .Cells(i, 13).Value
                  liste.SubItems(13) = .Cells(i, 14).Value
                liste.SubItems(14) = .Cells(i, 15).Value
                liste.SubItems(15) = .Cells(i, 16).Value
                liste.SubItems(16) = .Cells(i, 17).Value
                liste.SubItems(17) = .Cells(i, 18).Value
                End With
            End If
        Next i
        
End Sub
Textbox 1 e değer girdiğimde çok güzel bir şekilde arama yapıp listview de sıralıyor,sorunsuz...Şimdi sorun ne derseniz,arama sonuçları listview de sıralanırken şu kodlar işlevsiz oluyor:-(
Kod:
If UCase(Sheets("met").Cells(i, 5).Value) = "TEKRAR" Then
            ListView2.ListItems(i - 1).ForeColor = vbGreen
            For j = 1 To 17
                ListView2.ListItems(i - 1).ListSubItems(j).ForeColor = vbGreen
            Next
        End If
        If Sheets("met").Cells(i, 4).Value = "YOK" Then
            ListView2.ListItems(i - 1).ListSubItems(3).ForeColor = vbRed
        End If
Arama yapmazken hiç bir sıkıntım yok,yalnız texbox 1 e değer girip arama sonuçları listview de sıralanırken bu renklendirmenin çalışması için düzenleme gerekecek sanırım:-(
 
Üst