أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil مشكلة في الكود اكسيل اسئله واجابات


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





البحث عن طريق الليست بوكس

السلام عليكم ورحمة الله وبركاته اساتذنى الأعزاء والأجلاء تحية طيبة لدى فورمه بحث لكن كلما اريد ان اقوم بعملية البحث عن ..


موضوع مغلق


17-08-2022 03:22 مساء
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 

السلام عليكم ورحمة الله وبركاته
اساتذنى الأعزاء والأجلاء تحية طيبة
لدى فورمه بحث لكن كلما  اريد ان اقوم بعملية البحث عن كود موظف ياتى بأقرب اكواد متشابهه لكن كل ما اريده هو ظهور النتيجة بالضبط اى لو بحث عن كود موظف رقم 86535 بإسم / على عصام ابراهيم امام وليس اقرب نتيجة وايضاً لو ان الكود غير موجود تظهر رساله تفيد هذا الكود غير موجود .
وشكراً لكم جميعا على كل ما تقدموه لنا من مساعدات  ... تقبلوا تحياتى
 
 
  مجمع البيانات.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(64.114) KB



أفضل إجابة مقدمة من osama barawy وهي:
السلام عليكم
يمكن ذلك عن طريق استبدال جملة البحث :         'If InStr(CStr(.Cells(r, "A")), txt) Then
       
 بالجمله التالية      If .Cells(r, "A") = txt Then

ثم اضافة شرط فى نهاية البحث ليظهر الرسالة المطلوبة


Private Sub ButtonFind_Click()
Dim Ary()
Dim r As Long, rr As Long, Lr As Long
Dim C As Integer
Dim txt As String
Dim i As Integer

txt = Me.TextFind
Me.ListBox1.Clear

With Sheets("البيانات")
    Lr = .Cells(.Rows.Count, "A").End(xlUp).Row

    For r = 4 To Lr
           
      If .Cells(r, "A") = txt Then


            rr = rr + 1
            ReDim Preserve Ary(1 To Cont, 1 To rr)
            For C = 1 To Cont
                Ary(C, rr) = .Cells(r, C).Value
            Next
        End If
    Next
    
End With

If rr Then
Me.ListBox1.Column = Ary
Else
MsgBox "لم يتم العثور على الكود"
End If
Erase Ary
End Sub
عرض الإجابة




19-08-2022 02:05 مساء
مشاهدة مشاركة منفردة [1]
osama barawy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-10-2017
رقم العضوية : 1307
المشاركات : 24
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 27-5-1970
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 330
عدد الإجابات: 11
 offline 
look/images/icons/i1.gif البحث عن طريق الليست بوكس
السلام عليكم
يمكن ذلك عن طريق استبدال جملة البحث :         'If InStr(CStr(.Cells(r, "A")), txt) Then
       
 بالجمله التالية      If .Cells(r, "A") = txt Then

ثم اضافة شرط فى نهاية البحث ليظهر الرسالة المطلوبة


Private Sub ButtonFind_Click()
Dim Ary()
Dim r As Long, rr As Long, Lr As Long
Dim C As Integer
Dim txt As String
Dim i As Integer

txt = Me.TextFind
Me.ListBox1.Clear

With Sheets("البيانات")
    Lr = .Cells(.Rows.Count, "A").End(xlUp).Row

    For r = 4 To Lr
           
      If .Cells(r, "A") = txt Then


            rr = rr + 1
            ReDim Preserve Ary(1 To Cont, 1 To rr)
            For C = 1 To Cont
                Ary(C, rr) = .Cells(r, C).Value
            Next
        End If
    Next
    
End With

If rr Then
Me.ListBox1.Column = Ary
Else
MsgBox "لم يتم العثور على الكود"
End If
Erase Ary
End Sub

19-08-2022 06:03 مساء
مشاهدة مشاركة منفردة [2]
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 
look/images/icons/i1.gif البحث عن طريق الليست بوكس
الف مليون شكر يا استاذ/ اسامه
كفيت ووفيت هذا هو المطلوب بالضبط مشكووووور جداً وجعله الله تعالى فى ميزان حسناتك الى يوم القيامة.
لك من ولكل الأساتذة الكرام كل الاحترام والتقدير
142




الكلمات الدلالية
البحث ، طريق ، الليست ، بوكس ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 09:57 صباحا