Lıstbox veri süzme krıteri hk.

[kemal turan]

Merhabalar,
Aşağıdaki kodu sitemizden alıp kendime uyarlamaya çalışıyorum.takıldığım nokta Dizi(2, Say) = Veri sutunundaki verileri "başlayan harf" özellikli olarak süzüp lıstboxa getiriyor.
İsteğim ;
Örnek olarak "hasan hüseyin güzel" adında bir isim olsun.
Ben "güzel" yazdığımdada veriyi lıstbox getirsin.
Herhalde buna içeren kelimeye göre deniyor.
Kodumuzun neresinde nasıl bir değişiklik gerekiyor.
Teşekkür ederim.

Private Sub ListBox1_Click()

S1.Range("a1") = ListBox1.Value
satır = Sheets("sayfa1").Cells(Rows.Count, 3).End(3).Row + 1
Range("a1").Select
Selection.Copy
Sheets("sayfa1").Cells(satır, 3).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End Sub

Private Sub TextBox1_Change()
ReDim Dizi(1 To 7, 1 To 1)

On Error Resume Next
ListBox1.RowSource = Empty
ListBox1.Clear
On Error GoTo 0

If TextBox1 = "" Then
UserForm_Initialize
Else
Say = 0
Set Data = S2.Range("A2:G" & S2.Cells(Rows.Count, 2).End(3).Row)
For Each Veri In Data
If Veri.Column = 2 Then
If UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I")) Like _
UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I")) & "*" Then
Say = Say + 1
ReDim Preserve Dizi(1 To 7, 1 To Say)
Dizi(1, Say) = Veri.Offset(0, -1)
Dizi(2, Say) = Veri
Dizi(3, Say) = Veri.Offset(0, 1)
Dizi(4, Say) = Veri.Offset(0, 2)
Dizi(5, Say) = Veri.Offset(0, 3)
Dizi(6, Say) = Veri.Offset(0, 4)
Dizi(7, Say) = Veri.Offset(0, 5)
End If
End If
Next

If Say > 0 Then ListBox1.Column = Dizi
End If
End Sub

Private Sub UserForm_Initialize()
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("KAYITLAR")
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "250;170;30;30;30;30;30"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set S1 = Nothing
Set S2 = Nothing
Set Data = Nothing
End Sub

 

[Orion1]

kodu aşağıdaki koda kırmızı yıldız işareti ile yaptım.

If UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I")) Like _
[B][COLOR="Red"]& "*" &[/COLOR][/B] UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I")) & "*" Then

 

[kemal turan]

Merhaba Sn.Orıon
Cevabınızı anlayamadım veya uygulayamadım.:???:
İhtiyacımı daha iyi anlatabilmek için örnek dosya ekledim.
Teşekkür ederim.

 

[Orion1]

dosyanız ektedir.

 

[kemal turan]

Merhaba Sn.Orıon1 bey,
Çok teşekkür ederim.
İşiniz rast gitsin.
Selametle Kalınız.