Listbox da arama

[o2l3m]

Aşağıdaki ara adlı kod ile textbox lardan listbox3 de arama yaptırıyorum.
Fakat aradığım içeriği başından itibaren girmem gerekiyor. Ortadan başlarsam bulmuyor.

Text Box kodum;
--------------------------------------------------------------------------------------
Private Sub TextBox4_Change()
Call ara(TextBox4, Range("E3:E" & Cells(Rows.Count, "E").End(3).Row))
End Sub

--------------------------------------------------------------------------------------
Sub ara(ByVal txtbx As Object, alan As Range)
Dim deg As String, hcr As Range
deg = UCase(Replace(Replace(txtbx, "i", "İ"), "ı", "I")) & "*"
ListBox3.RowSource = ""
For Each hcr In alan
If hcr.Value <> "" Then
If UCase(Replace(Replace(hcr.Value, "i", "İ"), "ı", "I")) Like deg Then

ListBox3.AddItem
ListBox3.List(Satir, 0) = Range("B" & hcr.Row).Value
ListBox3.List(Satir, 1) = Range("C" & hcr.Row).Value
ListBox3.List(Satir, 2) = Range("D" & hcr.Row).Value
ListBox3.List(Satir, 3) = Range("E" & hcr.Row).Value
ListBox3.List(Satir, 4) = Range("F" & hcr.Row).Value
ListBox3.List(Satir, 5) = Range("G" & hcr.Row).Value
ListBox3.List(Satir, 6) = Range("H" & hcr.Row).Value
ListBox3.List(Satir, 7) = Range("I" & hcr.Row).Value
ListBox3.List(Satir, 8) = Range("J" & hcr.Row).Value

Satir = Satir + 1
End If
End If
Next
End Sub

 

[PLİNT]

Merhaba
Kırmızı bölümdeki gibi değişikliği deneyin
Listeyi temizlemek içinde mavi bölümü ekleyebilirsiniz

[SIZE="2"]Listbox3.RowSource = ""
[COLOR="Blue"]Listbox3.Clear[/COLOR]
For Each hcr In alan
If hcr.Value <> "" Then
If UCase(Replace(Replace(hcr.Value, "i", "İ"), "ı", "I")) Like[COLOR="Red"] "*" & deg & "*"[/COLOR] Then[/SIZE]

 

[o2l3m]

Bu ne hız. Çok teşekkürler. Çalışıyor