Textbox arama kodu

[skumova]

Arkadaşlar ekteki Userform1 de arama kodunu formu bozmadan içeren arama yapacak şekilde nasıl düzeltebilirim.Şu anki haliyle ürünün ya da kodun ilk harflerini girmek gerekiyor.(Sayfadaki Ürün ekle butonu ile Userform1 açılıyor.)
Teşekkürler
İyi Tatiller

 

[halit3]

Arkadaşlar ekteki Userform1 de arama kodunu formu bozmadan içeren arama yapacak şekilde nasıl düzeltebilirim.Şu anki haliyle ürünün ya da kodun ilk harflerini girmek gerekiyor.(Sayfadaki Ürün ekle butonu ile Userform1 açılıyor.)
Teşekkürler
İyi Tatiller

Bunu denermisiniz.

Private Sub TextBox1_Change()
TextBox1 = (TextBox1)
TextBox1 = Evaluate("=UPPER(" & """" & TextBox1 & """" & ")")
On Local Error Resume Next
satir = 0
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "3 cm;8 cm; 1 cm;2 cm;1 cm"
ListBox1.AddItem
ListBox1.Clear
Dim uzunluk As Integer
uzunluk = Len(TextBox1.Text)
If uzunluk > 0 Then
For i = 1 To 20000
For j = 1 To Len(Sayfa1.Cells(i, 2).Value)
If TextBox1.Text = Mid(Sayfa1.Cells(i, 2).Value, j, Len(TextBox1.Text)) Then
ListBox1.AddItem
ListBox1.List(satir, 0) = Sayfa1.Cells(i, 1).Value
ListBox1.List(satir, 1) = Sayfa1.Cells(i, 2).Value
ListBox1.List(satir, 2) = Sayfa1.Cells(i, 3).Value
ListBox1.List(satir, 3) = Sayfa1.Cells(i, 4).Value
ListBox1.List(satir, 4) = Sayfa1.Cells(i, 5).Value
satir = satir + 1
Exit For
End If
Next
Next i
End If
Label3.Caption = "Listelenen Kayıt Sayısı : " & ListBox1.ListCount
End Sub

 

[skumova]

Halit Bey çok teşekkür ederim ilginiz için.Fakat bu kod çok sıkıntılı çalışıyor.Userform kayboluyor bir müddet sonra tekrar geliyor.Benim eksik ifademde var galiba.Asıl istediğim şudur;herhangi bir işaret ekleyerek aramak istediğim harflere göre arama(* gibi) onun haricinde yazdığım şekliyle başlayan arama yapması.Bunu bazı ürünlerin hangi isimle başladığını hatırlayamadığım için istiyorum.

Tekrar ilginiz için teşekkürler.

 

[halit3]

Halit Bey çok teşekkür ederim ilginiz için.Fakat bu kod çok sıkıntılı çalışıyor.Userform kayboluyor bir müddet sonra tekrar geliyor.Benim eksik ifademde var galiba.Asıl istediğim şudur;herhangi bir işaret ekleyerek aramak istediğim harflere göre arama(* gibi) onun haricinde yazdığım şekliyle başlayan arama yapması.Bunu bazı ürünlerin hangi isimle başladığını hatırlayamadığım için istiyorum.

Tekrar ilginiz için teşekkürler.

Kod enter tuşuna basınca çalışıyor yani textbox nesnesinden çıkarken çalışıyor.

Private Sub TextBox1_AfterUpdate()
If TextBox1 = "" Then MsgBox "aranacak değeri yazmadınız.?": Exit Sub
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "3 cm;8 cm; 1 cm;2 cm;1 cm"
ListBox1.Clear
With Sayfa1.Range("B:B")
Set d = .Find(TextBox1.Text, LookIn:=xlFormulas, lookat:=xlPart)
If Not d Is Nothing Then
FirstAddress = d.Address
Do
ListBox1.AddItem
satir = ListBox1.ListCount - 1
ListBox1.List(satir, 0) = Sayfa1.Cells(d.Row, 1).Value
ListBox1.List(satir, 1) = Sayfa1.Cells(d.Row, 2).Value
ListBox1.List(satir, 2) = Sayfa1.Cells(d.Row, 3).Value
ListBox1.List(satir, 3) = Sayfa1.Cells(d.Row, 4).Value
ListBox1.List(satir, 4) = Sayfa1.Cells(d.Row, 5).Value
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
End Sub

 

[skumova]

Halit Bey,

Bu kodda tümüyle içeren arama yapıyor ve çok uzun sürüyor.Sadece başlayan harflerle aramayı normal şekilde yaparken, özel arama için (*) vb. işaret koyarak özel arama yapabileceğimiz bir kod uygulayabilrmiyiz.?

 

[halit3]

Halit Bey,

Bu kodda tümüyle içeren arama yapıyor ve çok uzun sürüyor.Sadece başlayan harflerle aramayı normal şekilde yaparken, özel arama için (*) vb. işaret koyarak özel arama yapabileceğimiz bir kod uygulayabilrmiyiz.?

Arkadaşlar ekteki Userform1 de arama kodunu formu bozmadan içeren arama yapacak şekilde nasıl düzeltebilirim.Şu anki haliyle ürünün ya da kodun ilk harflerini girmek gerekiyor.(Sayfadaki Ürün ekle butonu ile Userform1 açılıyor.)
Teşekkürler
İyi Tatiller

1 nolu mesajındaki sorunuza 4 nolu mesajımda cevap verdim. İyi çalışmalar

 

[skumova]

Halit Bey;

Ben anlayamamışım kusura bakmayın,kodlar çok güzel çalışıyor.Emeğiniz için teşekkürler.

Saygılarımla
Sertan KUMOVA