TextBox ile Veri Alırken Benzer Verileri Görüntülemek

[G.Bale]

Merhaba,
Dönem ödevimizin büyük bir kısmını tamamladık ancak tek bir pürüz kaldı o da userformdaki textboxlar doldurulurken, benzer verileri en altta bulunan büyük textboxta göstermek istiyoruz.

Programımız ad,soyad,eposta,telefon bilgilerini alıp hücrelere kaydediyor,
Ek olarak örneğin ad girerken, her harf girildiğinde benzer isimli olan kişilerin alttaki büyük textboxta gösterilmesi gerekiyor.

Örneğin, kayıtlı isimlerde Emre ve Emrah var diyelim.
Ad girerken "Em" yazdığımız zaman Emre ve Emrahın Ad soyad eposta telefon bilgileri aşağıdaki textboxta çıkmalı.

BURAYA TIKLAYARAK DOSYAYI İNDİREBİLİRSİNİZ

 

[Orion1]

Dosyanız linktedir.
Userformun initialize olayında textbox5in multiline özelliğini true yaptım.
NOT:Listeleme aracı olarak textbox yerine listbox kullanmanızı tavsiye ederim.

DOSYAYI İNDİR

Private Sub TextBox1_Change()
Dim sh As Worksheet, sonsat As Long, ad As String, deg As String
Dim k  As Byte
TextBox5.Value = ""
Set sh = Sheets("Sayfa1")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
ad = UCase(Replace(Replace(TextBox1.Text, "i", "İ"), "ı", "I"))
For i = 2 To sonsat
    If UCase(Replace(Replace(sh.Cells(i, "A").Value, "i", "İ"), "ı", "I")) Like ad & "*" Then
        For k = 1 To 4
            deg = deg & " " & sh.Cells(i, k).Value
        Next k
        deg = deg & vbCrLf
    End If
Next i
deg = Right(deg, Len(deg) - 1)
TextBox5.Text = deg
End Sub

 

[G.Bale]

Merhaba,
zaman ayırdığınız için teşekkürler.
Yalnız kodu çalıştırdığımda hata alıyorum:

deg = Right(deg, Len(deg) - 1)

Bu satırı sarı çiziyor

 

[Orion1]

yazdığınız ile başlamayan bir karakter girerseniz hata veriyor.
Benim yolladığım dosyada ben denedim hata vermiyor.
Kodların en başına aşağıdaki satırı ekleyin.

On Error Resume Next

 

[G.Bale]

Şu anda çalışıyor teşekkürler,
Tek eksik olarak soyadı eposta ve telefon numarası için de aynı aramayı yapması gerekiyor mümkünse...

 

[Orion1]

tüm textboxlarda şarta uyan ile başlara şartı ile arama yapıyor.Uyanları textbox5te listeliyor.
Dosyanız linktedir.

DOSYAYI İNDİR

Sub liste()
Dim sh As Worksheet, sonsat As Long, ad As String, deg As String
Dim k  As Byte, soyad As String, eposta As String, telefon As String
On Error Resume Next
TextBox5.Value = ""
Set sh = Sheets("Sayfa1")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
ad = UCase(Replace(Replace(TextBox1.Text, "i", "İ"), "ı", "I"))
soyad = UCase(Replace(Replace(TextBox2.Text, "i", "İ"), "ı", "I"))
eposta = UCase(Replace(Replace(TextBox3.Text, "i", "İ"), "ı", "I"))
telefon = UCase(Replace(Replace(TextBox4.Text, "i", "İ"), "ı", "I"))
For i = 2 To sonsat
    If UCase(Replace(Replace(sh.Cells(i, "A").Value, "i", "İ"), "ı", "I")) Like ad & "*" And _
            UCase(Replace(Replace(sh.Cells(i, "B").Value, "i", "İ"), "ı", "I")) Like soyad & "*" And _
            UCase(Replace(Replace(sh.Cells(i, "C").Value, "i", "İ"), "ı", "I")) Like eposta & "*" And _
            UCase(Replace(Replace(sh.Cells(i, "D").Value, "i", "İ"), "ı", "I")) Like telefon & "*" Then
For k = 1 To 4
            deg = deg & " " & sh.Cells(i, k).Value
        Next k
        deg = deg & vbCrLf
    End If
Next i
deg = Right(deg, Len(deg) - 1)
TextBox5.Text = deg
End Sub

 

[G.Bale]

Teşekkürler çok yardımı dokundu.