DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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.
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
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