السلام عليكم ورحمة الله تعالى وبركاته
بعد العودة الميمونة للمنتدى أحببت أن أقدم لكم هذا الملف عسى أن يفيد الجميع
نبدأ على بركة الله
الكود
Sub TxtFind1_Change()
Dim ws As Worksheet: Set ws = Sheets(1)
Dim I As Integer, v As Integer
Dim C As Range
Dim Rng As Range
For I = 1 To Col
Me.Controls("Txt" & I).Value = ""
Next I
ws.Activate
Lst1.Clear
Set Rng = Range("B6:B" & Range("B" & Rows.Count).End(xlUp).Row)
Rng.AutoFilter Field:=1, Criteria1:="=" & TxtFind1 & "*"
On Error Resume Next
For Each C In Rng.SpecialCells(xlCellTypeVisible)
If TxtFind1.Value = "" Then GoTo Finish:
If C Like TxtFind1 & "*" Then
Lst1.AddItem
For I = 0 To Col
Lst1.List(v, I) = Cells(C.Row, I + 1)
Next I
v = v + 1
End If
Next C
Finish:
ws.AutoFilterMode = False
End Sub
الجزئيات المهمة في الكود
أولا: جزئية التصفية
Rng.AutoFilter Field:=1, Criteria1:="=" & TxtFind1 & "*"
ثانيا: جزئية البحث في نطاق التصفية
Rng.SpecialCells(xlCellTypeVisible)
هنا عملية البحث تتم في الخلايا الظاهرة فقط