تسريع عملية البحث فى الليست بوكس حيث انها بطيئة جدا وتعمل على تهنيج الملف وشكرا

[هشام جمال الدين]

السلام عليكم اريد تسريع عملية البحث فى الليست بوكس حيث انها بطيئة جدا وتعمل على تهنيج الملف وايضا ضبط حجم العمود فى الليست بوكس وشكرا 

ليست بوكس بحث.xlsb

[عبدالفتاح في بي اكسيل]

جرب  هذا  التعديل  بالمصفوفة  مع  مراعاة  تسمية  الورقة  بالانجليزي  حتى  لا يحدث  مشاكل  في  الكود   يتم  اظهار  البيانات  بعد  كتابة  3   رقم 

Option Base 1

Private Sub TextBox8_Change()

Dim sh As Worksheet, ArchiveArray As Variant
Set sh = Sheets("archives")

ArchiveArray = sh.Range("A2:G" & Range("A" & Rows.Count).End(xlUp).Row).Value 'grab data into the array

Dim i As Long

If Len(TextBox8.Value) >= 3 Then 'if three characters entered...
    Me.ListBox1.Clear
    For i = 1 To UBound(ArchiveArray, 1) 'run through array

        If InStr(LCase(ArchiveArray(i, 1)), Me.TextBox8) <> 0 Then ' add to list if chars match
            With Me.ListBox1
                .ADDITEM ArchiveArray(i, 1)
                .List(ListBox1.ListCount - 1, 1) = ArchiveArray(i, 2)
                .List(ListBox1.ListCount - 1, 2) = ArchiveArray(i, 3)
                .List(ListBox1.ListCount - 1, 3) = ArchiveArray(i, 4)
                .List(ListBox1.ListCount - 1, 4) = ArchiveArray(i, 5)
                .List(ListBox1.ListCount - 1, 5) = ArchiveArray(i, 6)
                .List(ListBox1.ListCount - 1, 6) = ArchiveArray(i, 7)
            End With
        End If
        'Next x
    Next i
End If

End Sub

 

[هشام جمال الدين]

اخى الفاضل هل يمكن اضافتها للملف

[هشام جمال الدين]

جزاكم الله خيرا عبدالفتاح في بي اكسيل