TextBox'ta yazan veriyi ListBox'da Aratma

[monelogg]

Merhaba, TextBox'a harf/sayı/karakter yazdığım zaman o TextBox içeriğini ListBox verilerinden bulup, aynı ListBox'a getirsin istiyorum. Ayrıca,
TextBox1'in içeriğini sildiğimde tüm veri geri gelsin. Sadece boşluk girildiğinde aratmasın. Forumda bir iki bilgi buldum ama işin içinden çıkamadım. Bu konuda yardımcı olabilirseniz çok sevinirim.

 

[Orion1]

Dosyanız ektedir.

Private Sub TextBox1_Change()
Dim i As Long, sat As Long, deg As String, x As Long
sat = Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.RowSource = ""
txtbx = UCase(Replace(Replace(TextBox1.Text, "i", "İ"), "ı", "I"))
For i = 1 To sat
    deg = UCase(Replace(Replace(Cells(i, "A").Value, "i", "İ"), "ı", "I"))
    If UCase(Replace(Replace(deg, "i", "İ"), "ı", "I")) Like "*" & txtbx & "*" Then
        ListBox1.AddItem Cells(i, "A").Value
    End If
Next i
    
End Sub

 

[mancubus]

Private Sub TextBox1_Change()

    Dim sds As Long, j As Long
    
    ListBox1.Clear
    With Sheets("Sayfa1")
        sds = .Range("A" & .Rows.Count).End(xlUp).Row
        Select Case TextBox1.Value
            Case Is = " "
                ListBox1.Clear
            Case Is = ""
                ListBox1.List = .Range("A1:A" & sds).Value
            Case Else
                For j = 1 To sds
                    If InStr(1, .Cells(j, 1).Value, TextBox1.Value) > 0 Then
                        ListBox1.AddItem .Cells(j, 1).Value
                    End If
                Next j
        End Select
    End With
End Sub

 

[monelogg]

Sn. Orion1 ve Sn. mancubus cevaplarınız için çok teşekkür ederim iki kod da gayet güzel bir şekilde çalışıyor.


Kodlarla ilgili anlayamadığım iki sorum vardı onlara da bakabilen olursa çok sevinirim:

Sn. Orion1'in yazdığı kodun aşağıdaki satırını başka bir kodun içinde de bulmuştum ama nasıl çalıştığını hiç anlayamadım. Ayrıca i var I var onlar ne işe yarıyor?

    deg = UCase(Replace(Replace(Cells(i, "A").Value, "i", "İ"), "ı", "I"))

Sn. mancubus'un yazdığı kodda da şu satırı açıklayabilirseniz çok sevinirim.

      If InStr(1, .Cells(j, 1).Value, TextBox1.Value) > 0 Then

 

[Orion1]

Ucase ile değişkenin içinde verileri büyütüp,replace ilede i leri İ,ı ları I yapıyor.
Türkçe versiyon windowslarda sorun çıkmıyor ama ingilizce sürümlerde bu karakterlerde sorun yaşanıyor.
Onun için replace ile değiştiriyoruz.

 

[mancubus]

böyle konunun içinde kalarak çözüm üretmeye çalışırken yazılmış cevaplar varsa göremiyorsunuz. bu aralar 2. oldu benim için.

InStr fonksiyonu FIND (bul) ve SEARCH (mbul) fonksiyonlarının VBA'deki karşılığıdır diyebiliriz.

bir metin içerisinde, sol taraftan başka bir metin arayarak, bulduğu takdirde ilk bulduğu yerin metin içindeki sıra numarasını döndürür. bulamaz ise 0 rakamı döner.

yani fonksiyon sonucu 0'dan büyük ise aranan metin bulunmuş demektir. If ile bunu test ediyoruz. hücrede yer alan metinlerde TextBox1'e yazdığımız metin var mı. 0'dan büyük ise var demektir.

InStr(Başlangıç, Metin, AltMetin, Karşılaştırma)
Başlangıç: kaçıncı karakterden itibaren arama yapılacağı. default değer 1'dir. yazılmasına da gerek yoktur aslında.
Metin: içinde arama yapılacak metin
AltMetin: aranacak metin
Karşılaştırma: aramanın büyük harf - küçük harf duyarlı olup olmayacağı. default değer 0 yani duyarlı olup yazılmasına gerek yoktur. FIND-BUL gibi. 1 yazılır ise duyarsız olur. SEARCH-MBUL gibi.

 

[monelogg]

Sn. Orion1 ve Sn. mancubus cevaplarınız için çok çok teşekkür ediyorum, çok sağ olun...

 

[muratkayabasi82]

Dosyanız ektedir.

Private Sub TextBox1_Change()
Dim i As Long, sat As Long, deg As String, x As Long
sat = Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.RowSource = ""
txtbx = UCase(Replace(Replace(TextBox1.Text, "i", "İ"), "ı", "I"))
For i = 1 To sat
    deg = UCase(Replace(Replace(Cells(i, "A").Value, "i", "İ"), "ı", "I"))
    If UCase(Replace(Replace(deg, "i", "İ"), "ı", "I")) Like "*" & txtbx & "*" Then
        ListBox1.AddItem Cells(i, "A").Value
    End If
Next i
    
End Sub

hocam sizin formüle göre yaptım çok işe yaradı ancak bende 6 sütun var. Listboxa bunlar da geliyor ancak textboxa yazmaya başladığımda bulunan 1 tane oluyor. Uğraştım yapamadım.

 

[Mahmut Bayram]

Tablolarınız alt alta eklenirse istediğiniz işlem gerçekleşir.
Ekteki gibi ...
http://www.filebig.net/files/8Ue8DhSj32
Aksi takdirde ilave kod yazmak gerekir.

 

[muratkayabasi82]

Tablolar aslında 30 tane. 10×3 şeklinde. Yani alt alta olması benim için uygun olmayacak. Bu şekilde yapılamaz mi?

 

[Mahmut Bayram]

Murat bey, söylediğiniz yapılması çok zahmetli bir iş.
Nacizane çat pat ilmime göre imkansız demiyorum ama ayrı ayrı tanımlamalar ve listelemeler, birleştirmeler isteyen bir iş.
İlmini bilene çok kolay olabilir. Maalesef beni aşar.
Allah kolaylık versin.

 

[muratkayabasi82]

Hımm tamam teşekkürler yine de ilginiz için.

 

[muratkayabasi82]

Yardim lütfen..

 

[muratkayabasi82]

Yardım lütfen..

 

[sekhil]

Dosyanız ektedir.

Private Sub TextBox1_Change()
Dim i As Long, sat As Long, deg As String, x As Long
sat = Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.RowSource = ""
txtbx = UCase(Replace(Replace(TextBox1.Text, "i", "İ"), "ı", "I"))
For i = 1 To sat
    deg = UCase(Replace(Replace(Cells(i, "A").Value, "i", "İ"), "ı", "I"))
    If UCase(Replace(Replace(deg, "i", "İ"), "ı", "I")) Like "*" & txtbx & "*" Then
        ListBox1.AddItem Cells(i, "A").Value
    End If
Next i
    
End Sub

"sayfa2" açıkken arama userformu açıp arama yaptıgımda sayfa2 dekileri arıyor..

sayfa1 e sabitlenemezmi?