هل يمكن الاستدعاء بشرطين أو أكثر بالتعديل على هذا الكود

[أبو يوسف النجار]

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

الأساتذة عمالقة المنتدى تحية طيبة وبعد 

الملف بالمرفقات به كود استدعاء قائمة الفصل ممتاز

وهو بشرط الفصل فهل يمكن اضافة شرط ثانى مثلا : حالة القيد من المصدر ( بيانات الطلبة ) عمود G
ويكون الشرط الثانى بخلية بصفحة الهدف كمثل الهدف الأول الفصل ويبقى تقسيم القائمة لنصفين العدد بالتساوي بجانبى الصفحة ،  ولو زاد الكرم يصبح أكثر من شرطين

استدعاء بشرطين أو أكثر.rar

تم تعديل سبتمبر 29, 2018 بواسطه أبو يوسف النجار

[أبو يوسف النجار]

حبيبي المحترم وأستاذى الذي دائما أتعلم منه ( ياسر خليل أبو البراء )

دمت بخير وشكرا جزيلا

فقد أرسل لي الرد بمنتدى آخر وله جزيل الشكر الكود الجديد

Sub Grab_Class_List()

    Dim ws As Worksheet, sh As Worksheet, s1 As String, s2 As String

    Dim i As Long, j As Long, p As Long, n As Long, arr, temp

 

    Set ws = ThisWorkbook.Worksheets(1)

    Set sh = ThisWorkbook.Worksheets(2)

 

    sh.Range("B6:I35").ClearContents

    s1 = sh.Range("K1").Value: s2 = sh.Range("K2").Value

    arr = ws.Range("B10:G" & ws.Range("B" & Rows.Count).End(xlUp).Row).Value

    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)

 

    For i = 1 To UBound(arr, 1)

        If arr(i, 3) = s1 And arr(i, 6) = s2 Then

            p = p + 1

            For j = 1 To UBound(arr, 2)

                temp(p, j) = arr(i, j)

            Next j

            temp(p, j) = p

        End If

    Next i

 

    On Error Resume Next

        n = WorksheetFunction.Round(p / 2, 0)

        sh.Range("B6").Resize(n, 4).Value = Application.Index(temp, Evaluate("ROW(1:" & n & ")"), Array(j, 1, 5, 6))

        sh.Range("F6").Resize(n, 4).Value = Application.Index(temp, Evaluate("ROW(" & n + 1 & ":" & p + 1 & ")"), Array(j, 1, 5, 6))

    On Error GoTo 0

End Sub

 

روعة مستر / ياسر

[Ali Mohamed Ali]

بارك الله فيك دائما وفى استاذنا الكبير ياسر خليل ابو البراء

له منا كل الحب والإحترام وأدامه الله دائما عونا لنا جعله الله فى ميزان اعماله وغفر الله له

[الشافعي]

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