• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listview'i kendi listesi üzerinden süzme yapmak

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Selam,

Listview'e bir veri sayfasından döngü ile koşula bağlı veri alıyorum. Combobox veya Textbox değerine göre aynı veri sayfasından döngü ile süzme işlemi yapıyorum.
İsteğim şu listview'in kendi listesi üzerinden süzme işlemi yapabilir miyiz?
(biraz çabaladım Remove özelliğini kullandım pek sağlıklı olmadı.)
Yardımcı olabilirseniz çok sevinirim.

İyi çalışmalar.
 
Bunu denermisiniz.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
aranan = InputBox("Aranan değeri giriniz.", "Aranan", "")
If aranan = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For r = ListView1.ListItems.Count To 1 Step -1
j = 0
'On Error Resume Next
deg = 0
For i = 1 To ListView1.ColumnHeaders.Count - 1
If aranan = ListView1.ListItems(r).ListSubItems(i).Text Then
deg = 1
Exit For
End If
Next i
If deg = 0 Then
ListView1.ListItems.Remove (r)
End If
Next r
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
aranan = InputBox("Aranan değeri giriniz.", "Aranan", "")
If aranan = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
aranan = LCase(aranan)
For r = ListView1.ListItems.Count To 1 Step -1
j = 0
deg = 0
For i = 0 To ListView1.ColumnHeaders.Count - 1
If i = 0 Then
For j = 1 To Len(ListView1.ListItems(r).Text)
If Mid(LCase(ListView1.ListItems(r).Text), j, Len(aranan)) = aranan Then
deg = 1
Exit For
End If
Next
Else
For j = 1 To Len(ListView1.ListItems(r).Text)
If Mid(LCase(ListView1.ListItems(r).ListSubItems(i).Text), j, Len(aranan)) = aranan Then
deg = 1
Exit For
End If
Next
End If
If deg = 1 Then
Exit For
End If
Next i
If deg = 0 Then
ListView1.ListItems.Remove (r)
End If
Next r
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
aranan = InputBox("Aranan değeri giriniz.", "Aranan", "")
If aranan = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
aranan = LCase(aranan)
For r = ListView1.ListItems.Count To 1 Step -1
j = 0
'On Error Resume Next
deg = 0
For i = 0 To ListView1.ColumnHeaders.Count - 1
If i = 0 Then
If aranan = LCase(ListView1.ListItems(r).Text) Then
deg = 1
Exit For
End If
Else
If aranan = LCase(ListView1.ListItems(r).ListSubItems(i).Text) Then
deg = 1
Exit For
End If
End If
Next i
If deg = 0 Then
ListView1.ListItems.Remove (r)
End If
Next r
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub
 
Bunu denermisiniz.

Selam Hocam çok teşekkür ederim. Kodlarınızın hepsi birbirinden iyi. Bana en uygunu 2.si geldi.
Fakat şöyle bir sorun var.
1.Süzmeyi yaptıktan sonra birçok satırı kaldırdığı için, 2. süzme de istenilen şekilde yapmıyor. Sorun galiba benim yanlış metot ile süzme isteklerimden kaynaklanıyor.

İyi çalışmalar.
 
Geri
Üst