• DİKKAT

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

Listview de tektbox a yazılan harfe göre süzme

Katılım
23 Şubat 2007
Mesajlar
1,212
Excel Vers. ve Dili
Excel2003
Selamlar,
UserForm da TextBoxlarımız ve bir de Listview imiz var. TextBox1 e yazılan harfe göre listeleme yapmak istiyorum. Bir harf daha yazılınca yeniden. Saygılar.
 
Merhaba sbayyigit,
Öncelikle cevabınızdan dolayı teşekkür ederim.
Örnek güzel de ben Listview demiştim bu listBox. Bir de şu ayrıntı var. Listview FormInitalize olayına bağlı tüm verileri listeliyor. İlave olarak Listview deki verileri textbox taki harfe göre filtre edecek.
 
Kod şöyle ama harfe göre düzenliyemedim.
Sub ListeGuncelle2()
' SAYFADAKİ VERİLERİ LISTVIEW İÇİNE ALIR
Set Sh = Sheets("İSİM")
son = Sh.Cells(65536, 1).End(xlUp).Row
'yeni = True
With Userform1.ListView1
.ListItems.Clear
For i = 2 To son
.ListItems.Add , , Sh.Cells(i, 1)
'If Left((Sh.Cells(i, "A")), Len(TextBox1)) = (TextBox1) Then
'c = c + 1
'For j = 2 To 5
X = X + 1
With .ListItems(X).ListSubItems
.Add , , Sh.Cells(i, 2) ' BURADAKİ Sh.Cells(1, 2) İFADESİ ALINAN HÜCREDİR
.Add , , Sh.Cells(i, 3)
.Add , , Sh.Cells(i, 4)
.Add , , Sh.Cells(i, 5)
.Add , , i
End With
Next i
End With
Set Sh = Nothing
End Sub
 
hocam kusura bakma ben listbox olarak algılamıştım. özür dilerim.
 
Değerli Dostlar konu çözümlenmiştir. Zahmet etmeyin. Teşekkürler.
Private Sub TextBox1_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("İ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

If TextBox1 = "" Then ListeGuncelle
End Sub
 
Geri
Üst