اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طلب كود للبحث عن قيمة معينة بتوفر شرطين


الردود الموصى بها

لسلام عليكم ورحمة الله وبركاته

اخواني الاعزاء 

لدي طلب مساعده في ملف اكسل به يوزر فورم للبحث عن قيم معينه

يقوم اليوزرفورم بالبحث عن قيمة  (واحدة )معينه نقوم باختيارها من احد قوائم متعددةcombobox داخل الفورم واعطاء النتائج في ليست بوكس

لكن الكود الذي استخدمه يدعم البحث عن متغير واحد فقط مثال ابحث  في العمود A عن القيمة  أ واظهر النتائج في ليست بوكس .

المطلوب هو ان يتم البحث عن  القيمة أ في عمود A وتحق]ق شرط اخر ان يقابلها في عمود C مثلا قيمة ب ثم اظهار النتائج في ليست بوكس .

اي ابحث ولظهار النائج في ليست بوك اذا كان قيمة أ في عمود A ,و ب في عمود C 

 

الملف مرفق وبه اليوزر فورم

الرقم السري 221 للدخول الىالفيجوال بيسك

 

وشكرا

test.rar

تم تعديل بواسطه ماجد القثمي
رابط هذا التعليق
شارك

 

السلام عليكم

اللي فهمته من حضرتك اانك عاوز تظهر نتائج اكتر في الليست بوكس 

 

ولا ايه

يبقي دا الكود اللي بتبحث بيه 

يبقي هاجي علي اول سطر و اقول ان مالوش لازمه في الكود طالما ان حطيت بعده 

on error resume next

و كمان عند فنكشن البحث في سطر اف

If Application.WorksheetFunction.Search(M, Q, 1) = 1 Then

هغير رقم واحد اللي بعد 

Q

هاخليه (0

'ComboBox1_Find.value = Application.WorksheetFunction.Proper(ComboBox1_Find.value)
On Error Resume Next
Dim Ws As Worksheet
Dim V As Integer
Dim LastRow As Integer
Dim M As String
Dim Q, F
ListBox1.Clear
ListBox2.Clear

If ComboBox1_Find.Text = "" Then GoTo 1
M = ComboBox1_Find.Text
Set Ws = Sheets("Cases")
With Ws
      LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Q = .Range("F2:F" & LastRow).Find(M)
If Not Q Is Nothing Then
F = Q.Address
Do
If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then
ListBox1.AddItem Q.value
ListBox2.AddItem Q.value
ListBox1.List(V, 0) = Q.Offset(0, -5).value
ListBox1.List(V, 1) = Q.Offset(0, -4).value
ListBox1.List(V, 2) = Q.Offset(0, -3).value
ListBox1.List(V, 3) = Q.Offset(0, -2).value
ListBox1.List(V, 4) = Q.Offset(0, -1).value

ListBox2.List(V, 0) = Q.Offset(0, 0).value
ListBox2.List(V, 1) = Q.Offset(0, 1).value
ListBox2.List(V, 2) = Q.Offset(0, 2).value
ListBox2.List(V, 3) = Q.Offset(0, 3).value
ListBox2.List(V, 4) = Q.Offset(0, 4).value
ListBox2.List(V, 5) = Q.Offset(0, 5).value
ListBox2.List(V, 6) = Q.Offset(0, 6).value
ListBox2.List(V, 7) = Q.Offset(0, 7).value

 V = V + 1
 End If
 Set Q = .Range("F2:F" & LastRow).FindNext(Q)
 Loop While Not Q Is Nothing And Q.Address <> F
 End If
 End With
1 Me.ComboBox4.value = ""
Me.ComboBox5.value = ""
Me.ComboBox6.value = ""
Me.ComboBox7.value = ""
Me.ComboBox8.value = ""
Me.ComboBox9.value = ""
Me.ComboBox10.value = ""
Me.ComboBox4.Visible = False
Me.ComboBox5.Visible = False
Me.ComboBox6.Visible = False
Me.ComboBox7.Visible = False
Me.ComboBox8.Visible = False
Me.ComboBox9.Visible = False
Me.ComboBox10.Visible = False
CommandButton5.Visible = False
CommandButton7.Visible = False
End Sub
'=================================================================================
'Search by Lab Name
Private Sub ComboBox2_Find_Change()
On Error Resume Next
ComboBox2_Find.value = Application.WorksheetFunction.Proper(ComboBox2_Find.value)
Dim Ws As Worksheet
Dim V As Integer
Dim LastRow As Integer
Dim M As String
Dim Q, F
ListBox1.Clear
ListBox2.Clear

If ComboBox2_Find.Text = "" Then GoTo 1
M = ComboBox2_Find.Text
Set Ws = Sheets("Cases")
With Ws
      LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Q = .Range("H2:H" & LastRow).Find(M)
If Not Q Is Nothing Then
F = Q.Address
Do
If Application.WorksheetFunction.Search(M, Q, 1) = 1 Then
ListBox1.AddItem Q.value
ListBox2.AddItem Q.value
ListBox1.List(V, 0) = Q.Offset(0, -7).value
ListBox1.List(V, 1) = Q.Offset(0, -6).value
ListBox1.List(V, 2) = Q.Offset(0, -5).value
ListBox1.List(V, 3) = Q.Offset(0, -4).value
ListBox1.List(V, 4) = Q.Offset(0, -3).value

ListBox2.List(V, 0) = Q.Offset(0, -2).value
ListBox2.List(V, 1) = Q.Offset(0, -1).value
ListBox2.List(V, 2) = Q.Offset(0, 0).value
ListBox2.List(V, 3) = Q.Offset(0, 1).value
ListBox2.List(V, 4) = Q.Offset(0, 2).value
ListBox2.List(V, 5) = Q.Offset(0, 3).value
ListBox2.List(V, 6) = Q.Offset(0, 4).value
ListBox2.List(V, 7) = Q.Offset(0, 5).value

 V = V + 1
 End If
 Set Q = .Range("H2:H" & LastRow).FindNext(Q)
 Loop While Not Q Is Nothing And Q.Address <> F
 End If
 End With
1 Me.ComboBox4.value = ""
Me.ComboBox5.value = ""
Me.ComboBox6.value = ""
Me.ComboBox7.value = ""
Me.ComboBox8.value = ""
Me.ComboBox9.value = ""
Me.ComboBox10.value = ""
Me.ComboBox4.Visible = False
Me.ComboBox5.Visible = False
Me.ComboBox6.Visible = False
Me.ComboBox7.Visible = False
Me.ComboBox8.Visible = False
Me.ComboBox9.Visible = False
Me.ComboBox10.Visible = False
CommandButton5.Visible = False
CommandButton7.Visible = False

و يارب تكون المعلومه وصلت 

لو قصد حضرتك حاجه تانيه يريت توضح اكتر

رابط هذا التعليق
شارك

استاذ احمد غندور 

شكرا جزيلا لتجاوبك

يبدو اني لم اوفق في ايصال الفكرة, سوف اقوم بشرحها مجددا

الكود الذي استخدمه في الملف المرفق يقوم بالبحث عن اقيمة موجودة في الكومبو بوكس ويتم اختيارها من الليست للبحث عنها.

يوجد شيت  بها بيانات  تخص عدة (معامل)  والكومبو بوكس الخاص بالبحث عن اسم المعمل في حال اخترت اسم معمل معين سوف يظهر البيانات الخاصة بهذا المعمل في ليست بوكس

وكذلك البحث عن رقم الهاتف ونوع الحالة و و و  (بقية الكومبو بوكسز) هذه هي فكرة البحث الحالية.

ما اريده هو مثلا ان ابحث عن بيانات معمل محدد اذا كان القيمة في العمود( الحالة status) تساوي كلمة done مثلا او اذا كانت فارغه

مثال للتوضيح ...شيت به اسماء اشخاص واعمارهم وجنسياتهم

الكود الحالي يبحث عن اسم الاشخاص الذين اسمهم  محمد واظهار معلوماتهم في ليست بوكس ,سوف يظهر كل من اسمهم محمد في النتيجه

ما اريده هو اضافه شرط اخر مثال

ابحث عن الاشخاص الذين اسمهم محمد اذا كان جنسيتهم يمني (وليس كل المحمدين كما في الكود الاول) واظهر الحالات في ليست بوكس

هذه الفكرة التي اريد ان اغيرها في الكود

 

وشكرا

رابط هذا التعليق
شارك

  • 2 weeks later...
  • 2 weeks later...
  • 4 weeks later...

اخي الكريم

ادرج نموزج مبسط جداً وبدون تنسيقات  - اعرض فيه المطلوب ولا داعى لتلك الملفات بدون اعمده وصفوف وباسورد للفتح كما الفورم يكوم مبسط وبدون اكواد ... كي لا ياخذ الحل الكثيراً جدا من الوقت

تقبل مرورى وتحياتى 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information