ListViewda Textbox ile içerir süzmesi

[kocaeliartvin]

Private Sub TextBox7_Change()
TextBox1 = Evaluate("=UPPER(" & """" & TextBox1 & """" & ")")
' TEXTBOX İÇİNDE ARAMA YAPAR
'If KeyCode <> 13 Then Exit Sub
On Error Resume Next
If Trim(TextBox1.Value) = "" Then: listeguncelle: Exit Sub
Set sh = Sheets("Tüm Liste")
ara = TextBox1.Value
Set bulunacak = sh.Range("C:C").Find(ara & "*", LookAt:=xlWhole) 'VERİ HANGİ SÜTUNDA ARANACAK
If Not bulunacak Is Nothing Then
Adres = bulunacak.Address
ListView1.ListItems.Clear
Do
sat = bulunacak.Row
With ListView1
.ListItems.Add , , sh.Cells(sat, 1)
x = x + 1
With .ListItems(x).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
.Add , , sh.Cells(sat, 3)
.Add , , sh.Cells(sat, 4)
.Add , , sat
End With
End With
Set bulunacak = sh.Range("A:A").FindNext(bulunacak)
Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
Else
'MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
'TextBox1.Value = ""
listeguncelle
End If




Yukarıdaki kodlarla listviev nesnesi içinde textboxla süzme işlemi yapıyorum. Yanlız textboxa yazdığım değerler ile başlayan veriler listeleniyor sadece. Textboxa girilen değeri içeren kayıtları listeyebilen bir süzme işlemi için gerekli değişiklikler nelerdir. Muhtemel yardımları için ustalara şimdiden teşekkürler.

yani ...ile başlayan değil de, içeren.

 

[halit3]

Set bulunacak = sh.Range("C:C").Find(ara & "*", LookAt:=xlWhole)

yukarıda kodun yerine şağıdakini denermisiniz.

Set bulunacak = sh.Range("C:C").Find(ara & "*", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

 

[kelkitli]

Sayın kocaeliartvin,
aşağıdaki şekilde eklerseniz işlem tamamdır.

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' TEXTBOX İÇİNDE ARAMA YAPAR
'If KeyCode <> 13 Then Exit Sub
On Error Resume Next
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("İSİM")
ara = TextBox1.Value
Set bulunacak = Sh.Range("A:A").Find(ara & "*", LookAt:=xlWhole) 'VERİ HANGİ SÜTUNDA ARANACAK
If Not bulunacak Is Nothing Then
Adres = bulunacak.Address
ListView1.ListItems.Clear
Do
sat = bulunacak.Row
With ListView1
.ListItems.Add , , Sh.Cells(sat, 1)
X = X + 1
With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
.Add , , Sh.Cells(sat, 2)
.Add , , Sh.Cells(sat, 3)
.Add , , Sh.Cells(sat, 4)
.Add , , Sh.Cells(sat, 5)
.Add , , sat
End With
End With
Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
Else
'MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
'TextBox1.Value = ""
ListeGuncelle
End If

 

[kocaeliartvin]

Üstad ilgilendiğin çok teşekkür ederim.

Bu kodlarla süzme işlemi oldukça bi zahmetli oluyodu. Yani vakit alıyodu. Yine forumdan arkadaşların örneklerinden yararlanarak aşağıdaki kodu uyguladım. Oldukça güzel oldu. Ve tabiki daha hızlı. Ama ben sorunum hala aynı. İçerir süzmesi.

Birde bu koda göz atmanı rica edicem. Yoksa eski söylediğin işlemi yapıcam artık.

Private Sub TextBox1_Change()
Dim i As Long, sat As Long, sh As Worksheet, deg As String, x As Long
Set sh = Sheets("Tüm Liste")
sat = sh.Cells(65536, "B").End(xlUp).Row
ListView1.ListItems.Clear
deg = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) & "*"
For i = 1 To sat
If TextBox1.Text = "" Then deg = UCase(Replace(Replace(sh.Cells(i, "C").Value, "ı", "I"), "i", "İ"))
If UCase(Replace(Replace(sh.Cells(i, "C").Value, "ı", "I"), "i", "İ")) Like deg Then
x = x + 1
ListView1.ListItems.Add , , sh.Cells(i, "B").Value
ListView1.ListItems(x).SubItems(1) = sh.Cells(i, "C").Value
ListView1.ListItems(x).SubItems(2) = sh.Cells(i, "D").Value
End If
Next i
End Sub

 

[kelkitli]

Sorun şurda:
TextBox Change olayına yazılınca sıkıntı olur.
Change şu şekilde olsun.

Private Sub TextBox1_Change()
TextBox1 = Evaluate("=UPPER(" & """" & TextBox1 & """" & ")")
If TextBox1 = "" Then ListeGuncelle
End Sub

Diğer kodu ayrıca ekleyin.

 

[kocaeliartvin]

üstadlar ilginize teşekkürler.

Sayın kelkitli hocam;
kodlarınızı uyguladığımda textboxa girilen değer ile listede başlayan veri bulamadığında tümünü listeliyor. mümkünse ikinci gönderdiğim kod üzerinde değişiklik yaparak içerir süzmesi ekleyebilirmiyiz.

 

[kelkitli]

Siz veri bulunamazsa listelemesinmi diyorsunuz?
O zaman şöyle yapın.

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' TEXTBOX İÇİNDE ARAMA YAPAR
'If KeyCode <> 13 Then Exit Sub
On Error Resume Next
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("İSİM")
ara = TextBox1.Value
Set bulunacak = Sh.Range("A:A").Find(ara & "*", LookAt:=xlWhole) 'VERİ HANGİ SÜTUNDA ARANACAK
If Not bulunacak Is Nothing Then
Adres = bulunacak.Address
ListView1.ListItems.Clear
Do
sat = bulunacak.Row
With ListView1
.ListItems.Add , , Sh.Cells(sat, 1)
X = X + 1
With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
.Add , , Sh.Cells(sat, 2)
.Add , , Sh.Cells(sat, 3)
.Add , , Sh.Cells(sat, 4)
.Add , , Sh.Cells(sat, 5)
.Add , , sat
End With
End With
Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
Else
'MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
'TextBox1.Value = ""
'ListeGuncelle
End If
End Sub

Private Sub TextBox1_Change()
TextBox1 = Evaluate("=UPPER(" & """" & TextBox1 & """" & ")")
'If TextBox1 = "" Then ListeGuncelle
ListView1.ListItems.Clear
End Sub

 

[kocaeliartvin]

Üstad bu kodlar da son bulduğu şekilde bırakıyo listeyi. Yani textboxa girilen değer ile başlayan verileri listeliyor. Bulamayınca da son haliyle kalıyo liste.

ya usta kusura bakma ugrastiriyorum ama hala icerir suzmesini yapabilmis degiliz

 

[kelkitli]

O zaman en iyisi örnek dosya eklemeniz.

 

[Korhan Ayhan]

Selamlar,

İlk mesajınızdaki kod mantık olarak döngülü koddan daha hızlı çalışır. İlk mesajınızdaki kodda ilgili satırı aşağıdaki şekilde değiştirip denermisiniz.

Set bulunacak = sh.Range("C:C").Find(ara , LookAt:=xlPart) 'VERİ HANGİ SÜTUNDA ARANACAK

 

[kocaeliartvin]

Korhan hocam çok sağolun. Harika oldu desem yeridir.

Kelkitli üstadım elinize emeğinize sağlık. Çok uğraştırdım sizi de

İyi akşamlar

 

[halit3]

Sayın kocaeliartvin alıntı yaparak tekrar dönseydiniz iyi olurdu aşağıda iki kod var birisi kelimeye göre arıyor diğeri harfe göre arıyor.
iyi çalışmalar.

Set bulunacak = Sh.Range("C:C").Find(ara & "*", LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

Set bulunacak = Sh.Range("C:C").Find(ara & "*", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

 

[kocaeliartvin]

teşekkür ederim halit bey ilgilendiğiniz için. sağolun

 

[halit3]

teşekkür ederim halit bey ilgilendiğiniz için. sağolun

iyi çalışmalar

 

[by_IsTaNBuL]

Listview in kendi içindeki verileri textbox ile süzme

ekteki dosyada userform5 de ki listview in içindeki verileri süzme yaptırak istiyorum. fakat özeellikleri söyle sıralayayım.
1. listview de baska bir süzme makrosu daha var . ınpuotbox iel süzme yapıyor. bu duracak ve aynı bu sekılde süzme yapacak. yani örnek ben petibör yazmaya basladıgım zaman p den baslayacak süzmeye. her harfde bastıkça süzecek. ve diğer süzme işlemi ile çakışmayacak.

2. listview in sutun düzenini bozmayacak. aynı düzende arama yapacak.
3. aranan değer yoksa listview de hiç bir şey gözükmeyecek. değer yok diye uyaracak.