البحث عن طالب بدلالة 3 صفات له في عمود مجاور

[نايف - م]

السلام عليكم . عمود يحتوي أسماء الطلاب . عمود يحتوي صفات الطلاب الطول الوزن الذكاء .. أريد معرفة كل الطلاب الذين يحملون الصفات الموجود في 3 تكست بوكس 

20231013 test.rar

[ابراهيم الحداد]

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

ضع الكود التالى فى حدث الفورم

Private Sub CommandButton1_Click()
Dim Arr, Cond1, Cond2, Cond3
Dim Tmp, p
Arr = Range("A2:B9")
Cond1 = Me.TextBox1.Value
Cond2 = Me.TextBox2.Value
Cond3 = Me.TextBox3.Value
If Cond1 = "" Or Cond2 = "" Or Cond3 = "" Then
MsgBox "asdfghjkl"
Exit Sub
End If
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 2) = Cond1 Or Arr(i, 2) = Cond2 Or Arr(i, 2) = Cond3 Then
p = p + 1
For j = 1 To 2
Tmp(p, j) = Arr(i, j)
Next
End If
Next
With Me.ListBox1
 .Clear
 .AddItem
 .List = Tmp
End With
End Sub

 

[نايف - م]

السلام عليكم 

الأستاذ الكريم .. أريد الصفات في 3 تكست بوكس .. أعتقد أنه يجب أن أضع and بدل or

If Arr(i, 2) Like "*" & Cond1 & "*" And Arr(i, 2) Like "*" & Cond2 & "*" And Arr(i, 2) Like "*" & Cond3 & "*" Then

أستاذي الكريم و مع تغيير الكود كما سبق لم يعطي النتيجةالمطلوبة : طالب عنده هذه الصفات الثلاث

هل يمكن عمل ذلك

مع الشكر

 

 لقد بدلت السطر قبل الرد و لم ينجح الأمر

 

[ابراهيم الحداد]

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

اخى الكريم تستخدم علامة الربط and فى حالة ما اذا كانت معايير  المصفوفة على ثلاثة اعمدة مختلفة و هذا لا ينطبق على حالتنا هذه

[نايف - م]

السلام عليكم

قمت بالتغيير ل or

فكانت النتيجة كل طويل و كل سمين و كل ذكي .. المفروض أن تعطي سامر فقط لأنه الوحيد الطويل و السمين و الذكي .. و المفروض تعطي اسم سامر مرة واحدة كقيمة فريدة

20231013 test.xlsm

[حسونة حسين]

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

تفضل اخى

Private Sub CommandButton1_Click()
    Dim Ws As Worksheet, Arr, dic As Object, Levels, X
    Dim i As Long, R As Long, j As Long, P As Long
    Set Ws = ThisWorkbook.Worksheets("main")
    Arr = Ws.Range("A2:B" & Ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
    Set dic = CreateObject("Scripting.Dictionary")
    R = 1
    Levels = Array(TextBox1, TextBox2, TextBox3)
    Me.ListBox1.Clear
    ReDim B(1 To UBound(Arr, 1))
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If Not dic.Exists(Arr(i, 1)) Then
            dic.Add Arr(i, 1), R
            B(R) = Arr(i, 1) & "-" & Split(Arr(i, 2))(0)
            R = R + 1
        Else
            B(dic(Arr(i, 1))) = B(dic(Arr(i, 1))) & "-" & Split(Arr(i, 2))(0)
        End If
    Next i
    ReDim Tmp(1 To R - 1)
    For i = LBound(B, 1) To R - 1
        If UBound(Split(B(i), "-")) = UBound(Levels) + 1 Then
            For j = 1 To UBound(Levels) + 1
                X = Application.Match(Split(B(i), "-")(j), Levels, 0)
                If IsError(X) Then GoTo 1
            Next j
            P = P + 1
            Tmp(P) = Split(B(i), "-")(0)
        End If
1   Next i
    If P > 0 Then Me.ListBox1.List = Application.Index(Tmp, Evaluate("row(1:" & P & ")"))
End Sub

 

 

test.xlsm

[نايف - م]

الحمدلله و لك الشكر و جزاك الله خيرا 

أستاذي :  المطلوب بالضبط

لكن سؤال أخير قبل أن نغلق الموضوع 

هذا الكود يلزم كثيرا مع تغير قاعدة البيانات و الأعمدة المطلوبة

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

لك وافر أحترامي 

[حسونة حسين]

يمكنك رفع ملف اخر

في موضوع جديد

يكون نسخه مصغره من ملفك ببيانات بسيطه 

لكى نفهم المطلوب جيدا

[نايف - م]

السلام عليكم

الكود يعمل بأمتياز لكن الحقيقة لم أفهم آلية عمله

يمكن ذلك اذا تغير ترتيب الأعمدة و عددها حتى أستطيع تطبيقه على أية جدول

 

test.xlsm

[حسونة حسين]

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

عدل نطاق المصفوفه من 

Arr = Ws.Range("A2:B" & Ws.Cells(Rows.Count, 1).End(xlUp).Row).Value

الى

Arr = Ws.Range("B2:E" & Ws.Cells(Rows.Count, 2).End(xlUp).Row).Value

وعدل عامود الشروط من العامود الثانى في المصفوفه

Arr(i, 2)

الى العامود الرابع في المصفوفه

Arr(i, 4)

 

[نايف - م]

تمااام هو المطلوب جزاك الله خيرا

[حسونة حسين]

وجزاكم مثله اخى 

الحمد لله الذي بنعمته تتم الصالحات