أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .




06-12-2017 11:35 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 1764
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 8
يتابعهم : 0
يتابعونه : 152
قوة السمعة : 4937
الاعجاب : 1403
 offline 
look/images/icons/i1.gif مشكلة البطء في عملية البحث في الملف المرفق
وعليكم السلام أخي الكريم
بدلاً من وضع الكود في حدث التغير في صندوق النص يفضل وضعه في حدث الخروج بحيث لا يتم تنفيذ الكود في كل تغيير ومع كل تغيير في كل حرف
جرب الكود التالي عله يفي بالغرض .. بعد تحديد العمود المطلوب البحث عنه من خلال الكومبوبوكس قم بكتابة النص المطلوب البحث عنه ثم انقر Tab للخروج من التكست بوكس وتنفيذ عملية البحث
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim w           As Worksheet
    Dim a           As Variant
    Dim b()         As Variant
    Dim c           As Variant
    Dim s           As String
    Dim i           As Long
    Dim k           As Long

    Set w = ThisWorkbook.Worksheets("Data")
    Me.ListBox1.Clear
    If Me.TextBox1.Value = "" Or Me.ComboBox1.Value = "" Then Exit Sub

    a = w.Range("A3:J" & w.Cells(Rows.Count, 1).End(xlUp).Row).Value
    s = Me.ComboBox1.Value
    c = Application.Match(s, w.Rows(2), 0)
    
    If Not IsError(c) Then
        For i = 1 To UBound(a, 1)
            If InStr(UCase$(a(i, c)), UCase$(Me.TextBox1.Value)) > 0 Then
                ReDim Preserve b(1 To k + 1)
                b(UBound(b)) = Application.Index(a, i, 0)
                k = k + 1
            End If
        Next i
    End If

    On Error Resume Next
        If UBound(b) > 0 Then If UBound(b) = 1 Then Me.ListBox1.Column = Application.Index(b, 0, 0) Else Me.ListBox1.List = Application.Index(b, 0, 0)
    On Error GoTo 0
End Sub



الساعة الآن 10:58 مساء