listboxta gelişmiş arama

[osmanfenerli1907]

herkese kolay gelsin.
textboxa yazdığımız bir heceyi harfi ya da kelimeyi listboxun içinde nasıl aratabiliriz.yani textboxa os yazdığımda hiç bir tuşa tıklamadan listboxta sadece içinde os geçen kelimeleri listeliyecek.listbox sayfa1den a sutunundan bilgi alıyor.yardımlarınız için teşekkürler

 

[Orion1]

Private Sub TextBox1_Change()
Dim k As Range, sat As Long, i As Long, adr As String
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
ListBox1.Clear
Set k = Sheets("Sayfa1").Range("A1:A" & sat).Find(TextBox1.Text, , xlValues, xlPart)
If Not k Is Nothing Then
    adr = k.Address
    Do
        ListBox1.AddItem k.Value
        Set k = Sheets("Sayfa1").Range("A1:A" & sat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
End Sub

 

[osmanfenerli1907]

hocam teşkkürler ama küçük sorunlar kaldı.
1)aslında benim listeleme işlemim 3 sutunlu yani isim telefon1 telefon2 diye listeliyor.ancak arama isme göre yapılacak.
2)userformu ilk açtığımda bütün sayfayı listelicek. UserForm_Initialize() ye tamamını listeleme kodlarımı yazınca textboxtan aramada listbox1.clear hata veriyor

 

[Orion1]

hocam teşkkürler ama küçük sorunlar kaldı.
1)aslında benim listeleme işlemim 3 sutunlu yani isim telefon1 telefon2 diye listeliyor.ancak arama isme göre yapılacak.
2)userformu ilk açtığımda bütün sayfayı listelicek. UserForm_Initialize() ye tamamını listeleme kodlarımı yazınca textboxtan aramada listbox1.clear hata veriyor

Bunu belirtmeniz lazımdı ilk anda.Bu sütunlar hangi sütunlar?
2)listbox1.clear yerine listbox1.rowsource="" kullanın.
Ayrıca niye örnek dosya yolamıyorsunuz oda ayrı konu.Böyle gördüğünüz gibi kör döğüşü oluyor.

 

[osmanfenerli1907]

hocam teşkkürler ama küçük sorunlar kaldı.
1)aslında benim listeleme işlemim 3 sutunlu yani isim telefon1 telefon2 diye listeliyor.ancak arama isme göre yapılacak.
2)userformu ilk açtığımda bütün sayfayı listelicek. UserForm_Initialize() ye tamamını listeleme kodlarımı yazınca textboxtan aramada listbox1.clear hata veriyor

 

[osmanfenerli1907]

özür dilerim.
A B C sutunlarından listeliyor.ben aramayı A sutununa göre yapacağım.birde şu kolon başlıkları isim kodlarını hatırlatırsanız sevinirim.

 

[Orion1]

özür dilerim.
A B C sutunlarından listeliyor.ben aramayı A sutununa göre yapacağım.birde şu kolon başlıkları isim kodlarını hatırlatırsanız sevinirim.

Row source yöntemi dışında diğer metodlarda kolon başlıklarını listeleyemezsiniz.
Kolon başlığı için:

ListBox1.ColumnHeads = True

Diğer kodda aşağıdadaır.

Private Sub TextBox1_Change()
Dim k As Range, sat As Long, i As Long, adr As String,x as long
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
ListBox1.rowsource=""
Set k = Sheets("Sayfa1").Range("A1:A" & sat).Find(TextBox1.Text, , xlValues, xlPart)
If Not k Is Nothing Then
    adr = k.Address
    Do
        ListBox1.AddItem
        listbox1.list(x,0)=  k.Value
        listbox1.list(x,1)=k.offset(0,1).value
        listbox1.list(x,2)=k.offset(0,2).value
        x=x+1
        Set k = Sheets("Sayfa1").Range("A1:A" & sat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
End Sub

 

[osmanfenerli1907]

hocam bu listboxta satır renklendirme olabilir mi?

 

[Orion1]

hocam bu listboxta satır renklendirme olabilir mi?

Olamaz.
Bunun için spreadsheet kontrolünü kullanabilirsiniz.

 

[nihattt]

kodu aşağıdaki gibi değiştirdim. arama yapınca gayet güzel listeleniyor
fakat listede çıkan isimlerin veri olarak karşılıkları sütundaki ilk kayıttan aşağı doğru sıralanıyor. Yani listbox'ta aramada çıkan ilk isme tıklarsam bana b1'in bilgilerini getiriyor(textboxlara), ikinciyi tıklarsam b2'yi vs. devam ediyor. nerede bi hata veya eksiklik olabilir. yardımcı olursanız sevinirim. Hali hazırda bulunan listbox1'e adapte etmeye çalıştım.

Private Sub TextBox72_Change()
Dim k As Range, sat As Long, i As Long, adr As String
sat = Sheets("data").Cells(65536, "B").End(xlUp).Row
ListBox1.RowSource = ""
ListBox1.ColumnCount = 1
ListBox1.ColumnWidths = "130"
Set k = Sheets("data").Range("B1:B" & sat).Find(TextBox72.Text, , xlValues, xlPart)
If Not k Is Nothing Then
adr = k.Address
Do
ListBox1.AddItem k.Value
Set k = Sheets("data").Range("B1:B" & sat).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
End If
End Sub

 

[Orion1]

kodu aşağıdaki gibi değiştirdim. arama yapınca gayet güzel listeleniyor
fakat listede çıkan isimlerin veri olarak karşılıkları sütundaki ilk kayıttan aşağı doğru sıralanıyor. Yani listbox'ta aramada çıkan ilk isme tıklarsam bana b1'in bilgilerini getiriyor(textboxlara), ikinciyi tıklarsam b2'yi vs. devam ediyor. nerede bi hata veya eksiklik olabilir. yardımcı olursanız sevinirim. Hali hazırda bulunan listbox1'e adapte etmeye çalıştım.

Private Sub TextBox72_Change()
Dim k As Range, sat As Long, i As Long, adr As String
sat = Sheets("data").Cells(65536, "B").End(xlUp).Row
ListBox1.RowSource = ""
ListBox1.ColumnCount = 1
ListBox1.ColumnWidths = "130"
Set k = Sheets("data").Range("B1:B" & sat).Find(TextBox72.Text, , xlValues, xlPart)
If Not k Is Nothing Then
adr = k.Address
Do
ListBox1.AddItem k.Value
Set k = Sheets("data").Range("B1:B" & sat).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
End If
End Sub

Textboxtaki kodu aşağıdaki ile değiştirin.
listboxtaki clcik olayınada aşağıdaki kodu yazın

Private Sub TextBox72_Change()
Dim k As Range, sat As Long, i As Long, adr As String,x as long
sat = Sheets("data").Cells(65536, "B").End(xlUp).Row
ListBox1.RowSource = ""
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "130,0"
Set k = Sheets("data").Range("B1:B" & sat).Find(TextBox72.Text, , xlValues, xlPart)
If Not k Is Nothing Then
    adr = k.Address
    Do
        ListBox1.AddItem
        listbox1.list(x,0)= k.Value
        listbox1.list(x,1)=k.row
        x=x+1
        Set k = Sheets("data").Range("B1:B" & sat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
End Sub

textboxların ismine siz kendi textboxların ismini yazınız.

Private Sub ListBox1_Click()
MsgBox ListBox1.Column(1)
TextBox[B][COLOR="Red"]73[/COLOR][/B].Text = Sheets("data").Cells(ListBox1.Column(1), "C").Value
TextBox[B][COLOR="Red"]74[/COLOR][/B].Text = Sheets("data").Cells(ListBox1.Column(1), "D").Value
End Sub

 

[nihattt]

tşk ederim hocam bir deniyeyim inş. olur. sonucunu yazarım buraya.