جلب اسماء التلميذ ووضعها اسفل بعضها بناء على شرطين

[فوزى فوزى]

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

كشف المحولون الى المدرسة.xlsx

[أحمد يوسف]

أخى الكريم فوزى يجب عليك الإنتباه جيدا عند رفع المشاركة ,فقبل رفع المشاركة لتجنب اهدار وقت الأساتذة فعليك اولا استخدام خاصية البحث بالمنتدى هل ما اطلبه موجود وتم نقاشه بالفعل سابقا ام لا ؟!!!

كما انه عند عمل قوائم للفصول من صفحة البيانات لابد من اختيار فصل واحد وليس اكثر من فصل , فلما اذن قمنا بعمل هذه القوائم من الأساس اذا كان هناك اكثر من فصل

فلا يمكن ان يكون هذا طبيعى ومنطقى فى العمل

فهناك مئات المشاركات التى تناولت طلبك , فعليك اختيار منها ما يناسبك :

برنامج لعمل قوائم الفصول 2018

عمل قوائم للفصول تلقائية

قوائم فصول

زيادة عدد الطلبة فى قائمة الفصول

اسماء الفصول

 

[سليم حاصبيا]

بعد تغيير اسماء الصفحات  الى  Source و  Target نفذ هذا الكود

 Option Explicit
Sub get_data()
  Dim S As Worksheet, T As Worksheet
  Dim Rg_T As Range, Cel_T As Range
  Dim Cel_S As Range, Rg_S As Range
  Dim Dc As Object, K
  Dim m%: m = 5

  Set S = Sheets("Source")
  Set T = Sheets("Target")
  Set Rg_T = T.Range("W5", Range("W4").End(4))
  Set Rg_S = S.Range("C9", S.Range("C8").End(4))
  Set Dc = CreateObject("Scripting.Dictionary")
T.Range("AA4").CurrentRegion.Offset(1).ClearContents
 
 For Each Cel_T In Rg_T
   K = Cel_T & Cel_T.Offset(, 1)
    For Each Cel_S In Rg_S
      If Cel_S & Cel_S.Offset(, 1) = K Then _
      Dc(Cel_S.Offset(, -1).Value) = ""
    Next Cel_S
   T.Cells(m, "AA").Resize(Dc.Count) = _
   Application.Transpose(Dc.keys)
   m = m + Dc.Count: Dc.RemoveAll
 Next Cel_T
 Set Dc = Nothing
End Sub

الملف مرفق

 

Fousoul_stds.xlsm

[فوزى فوزى]

الله يرضى عليك استاذ سليم وعلى والديك نعم هذا هو المطلوب اللهم اجبر بخاطركم كما جبرتم بخاطرنا

استاذ سليم فضلا وتكرما منكم  ممكن اضافة على الكود يتم تلوين بين الفصل وبعضه نفرض اخترت من القائمة المنسدلة التى تخص النوع ذكر  واختر من القائمة المنسدلة التى تخص الفصل فصل 6 / 1 عند اخر اسم يتم تلوين الخلية حتى اعلم نهاية الفصل من الذكور والاناث والفصل الاخر لانى تهت فى الاسماء ولكم منا كل احترام وتقدير

 

[سليم حاصبيا]

تم التعديل على الماكرو ليتناسب مع المطلوب

Option Explicit
Sub get_data_new()
  Dim S As Worksheet, T As Worksheet
  Dim Rg_T As Range, Cel_T As Range
  Dim Rg_S As Range, Cel_S As Range
  Dim Dc As Object, K
  Dim x%, lr%, m%: m = 5
 
  
  Set S = Sheets("Source")
  Set T = Sheets("Target")
  Set Rg_T = T.Range("W5", Range("W4").End(4))
  Set Rg_S = S.Range("C9", S.Range("C8").End(4))
  Set Dc = CreateObject("Scripting.Dictionary")
    
    With T.Range("AA4").CurrentRegion.Offset(1)
      .Interior.ColorIndex = xlNo
      .ClearContents
    End With
  
  T.Range("AA5").Resize(, 3).Interior.ColorIndex = 40
For Each Cel_T In Rg_T
       K = Cel_T & " " & Trim(Cel_T.Offset(, 1))
      For Each Cel_S In Rg_S
        If Cel_S & " " & _
        Trim(Cel_S.Offset(, 1)) = K Then _
        Dc(Cel_S.Offset(, -1).Value) = ""
      Next Cel_S
    
    With T.Cells(m, "AA")
      .Resize(Dc.Count) = _
        Application.Transpose(Dc.keys)
        lr = .Parent.Cells(Rows.Count, "AA").End(3).Row
      .Parent.Cells(lr + 1, "AA").Resize(, 3) _
      .Interior.ColorIndex = 40
      .Offset(, 1).Resize(, 2) = _
       Split(K, " ", 2)
    End With
    
    m = m + Dc.Count: Dc.RemoveAll
Next Cel_T
 T.Range("AA" & lr + 1).Resize(, 3). _
 Interior.ColorIndex = xlNo
 Set Dc = Nothing
End Sub

 

 

Fousoul_stds_with color.xlsm

[فوزى فوزى]

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