الموضوع بسيط اتفضل الكود دا
CODE
Private Sub TextBox1_Change()
Dim myArray, lr, X, targt, targtN
Dim SERCH As Worksheet, DATA As Worksheet
'____________________________________________
Set DATA = Worksheets("Sheet2") 'اسم شيت قاعدة البيانات
Set SERCH = Worksheets("Sheet1") 'اسم الشيت الخاص بالبحث
'____________________________________________
lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row 'اخر صف به بيانات
ListBox1.Clear 'مسح نطاق البحث القديم
targt = TextBox1.Text 'خلية البحث
targtN = ComboBox1.ListIndex + 1 'دالة لايجاد رقم عمود البحث
myArray = DATA.Range("A2:O" & lr + 1) 'نطاق البحث
'____________________________________________
For X = LBound(myArray) To UBound(myArray)
If targt = "" Then Exit Sub
If myArray(X, targtN) Like targt & "*" Then
n = n + 1
End If
Next X
ReDim y(1 To n, 1 To 15)
For X = LBound(myArray) To UBound(myArray)
If targt = "" Then Exit Sub
If myArray(X, targtN) Like targt & "*" Then
rw = rw + 1
For yy = 1 To 15
y(rw, yy) = myArray(X, yy)
Next yy
End If
Next X
If rw > 0 Then
ListBox1.AddItem
ListBox1.List = y()
n = 0
End If
End Sub
