Soru ARAMA VE SÜZME

[yamahato]

Arkadaşlar merhaba.
Ufak bir excel dosyam var. Bu excel dosyasında vb ile arama ön yüzü yaptım. fakat internetten bulduğum kodları girdiğimde bir türlü istediğim sonucu alamadım. Sorunu çözmeme yardımcı olabilirmisiniz?

İndir ÇALIŞMA

Dosyayı indir ÇALIŞMA

dosya.co

https://dosya.co/hm7pecv40xqk/ÇALIŞMA.xlsm.html

 

[YUSUF44]

Ekli dosyayı inceleyiniz:

ÇALIŞMA.xlsm

drive.google.com

 

[yamahato]

Ekli dosyayı inceleyiniz:

ÇALIŞMA.xlsm

drive.google.com

Çok teşekkür ederim. Kod süper çalışıyor, sadece bir sıkıntı var. Mesela 2 rakamını girdiniz, eğer 2 rakamı 5 taneden fazla varsa program kendini kitliyor. ben onu 5 adeti 500 yaparak aştım. ama düzeltirsek süper olur.

 

[YUSUF44]

Userformdaki Textbox1.change kodlarını aşağıdakiyle değiştirip deneyiniz. 5'ten fazla sonuç olduğunda aramayı durdurur:

Private Sub TextBox1_Change()
If Len(TextBox1.Text) = 0 Then
    ListBox1.Clear
    Exit Sub
End If
Dim hucre As Range
Set s1 = Sheets("VERİ LİSTESİ")
son = s1.Cells(Rows.Count, "A").End(3).Row
10:
adet = 0
ListBox1.Clear
For Each hucre In s1.Range("E2:G" & son)
    If hucre <> "" Then
        veri = Split(hucre, Chr(10))
        For parca = 0 To UBound(veri)
            If Left(veri(parca), Len(TextBox1)) = TextBox1.Text Then
                adet = adet + 1
                If adet > 5 Then
                    MsgBox "En az " & adet & " adet sonuç bulundu." & Chr(10) & _
                        "Lütfen bir karakter daha giriniz!", vbInformation
                    ListBox1.Clear
                    Exit Sub
                End If
                ListBox1.AddItem (s1.Cells(hucre.Row, "A").Value)
                parca = UBound(veri)
            End If
        Next
    End If
Next
End Sub