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

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


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





لجان الدور الثاني حسب المادة وحسب الجنس

السلام عليكم ورحمة الله وبركاته أخواني الكرام كيف حالكم حميعا أريد التعديل على المعادلة أو كود لجلب الطلبة لشيت اللجنة ..


موضوع مغلق


25-11-2020 08:32 صباحا
Khairi
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 11-11-2017
رقم العضوية : 1466
المشاركات : 181
الجنس : ذكر
تاريخ الميلاد : 20-12-1973
يتابعهم : 7
يتابعونه : 6
قوة السمعة : 116
 offline 

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


أخواني الكرام كيف حالكم حميعا

أريد التعديل على المعادلة أو كود لجلب الطلبة لشيت اللجنة حسب المادة وحسب الجنس


ولكم مني جزيل الشكر
 
 
  لجان الدور الثاني حسب الجنس.xlsm   تحميل xlsm مرات التحميل :(7)
الحجم :(1849.759) KB



أفضل إجابة مقدمة من salim وهي:
1-للمرة الـ 100 بعد الألف اختصار الملف ( لماذا اكثر من 500 طالب في كل ورقة)
2- انت وضعت 6 لجان كل واحدة تحتوي عل 15 اسم اي 90 طالب
    ما ادراك بعدد الطلاب (دور ثاني - ذكور  او  أناث)   كيف تعرف ان 6 لجان نكفيهم  ربما نحتاج الى 7 مثلاً أو 5 أو 10
3- كيف نعرف ان الطالب دور ثاني
4- على كل حال جرب هذا الماكرو

Option Explicit

Sub Get_data()
Application.EnableEvents = False
  Dim s_rg As Range, find_rg As Range
  Dim Mou3addaL#, last_Clas%, I%, m%, col%
  Dim Mal_Femal$
  Dim First_sheet As Worksheet
  Dim Second_sheet As Worksheet
  Dim Position%, k%
  Position = 19
  Set First_sheet = Sheets("ف.1.أ")
  Set Second_sheet = Sheets("اللجنة")
    Mal_Femal$ = Second_sheet.Cells(1, 7)
  For I = 4 To 300 Step Position
    If Second_sheet.Cells(I - 1, 2) = "" Then Exit For
    Second_sheet.Cells(I, 2).Resize(15, 3).ClearContents
  Next
If Mal_Femal = "" Then Exit Sub

last_Clas = First_sheet.Cells(Rows.count, 2).End(3).Row
Set find_rg = First_sheet.Rows(4).Find(Second_sheet.Cells(1, 6), lookat:=1)
If find_rg Is Nothing Then Exit Sub
col = find_rg.Column + 8
Mou3addaL = Val(First_sheet.Cells(8, col)) / 2
m = 4: k = 1
 For I = 10 To last_Clas
  If First_sheet.Cells(I, col) < Mou3addaL And _
     First_sheet.Cells(I, 4) = Mal_Femal Then
        If m Mod 19 = 0 Then m = m + 4: k = 1
          With Second_sheet.Cells(m, 2)
            .Value = k
            .Offset(, 1) = First_sheet.Cells(I, 3)
            .Offset(, 2) = First_sheet.Cells(I, 6)
          End With
     m = m + 1: k = k + 1
   End If
Next
  Application.EnableEvents = True
End Sub


الملف (نموذج)

 
عرض الإجابة




25-11-2020 05:01 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif لجان الدور الثاني حسب المادة وحسب الجنس
1-للمرة الـ 100 بعد الألف اختصار الملف ( لماذا اكثر من 500 طالب في كل ورقة)
2- انت وضعت 6 لجان كل واحدة تحتوي عل 15 اسم اي 90 طالب
    ما ادراك بعدد الطلاب (دور ثاني - ذكور  او  أناث)   كيف تعرف ان 6 لجان نكفيهم  ربما نحتاج الى 7 مثلاً أو 5 أو 10
3- كيف نعرف ان الطالب دور ثاني
4- على كل حال جرب هذا الماكرو

Option Explicit

Sub Get_data()
Application.EnableEvents = False
  Dim s_rg As Range, find_rg As Range
  Dim Mou3addaL#, last_Clas%, I%, m%, col%
  Dim Mal_Femal$
  Dim First_sheet As Worksheet
  Dim Second_sheet As Worksheet
  Dim Position%, k%
  Position = 19
  Set First_sheet = Sheets("ف.1.أ")
  Set Second_sheet = Sheets("اللجنة")
    Mal_Femal$ = Second_sheet.Cells(1, 7)
  For I = 4 To 300 Step Position
    If Second_sheet.Cells(I - 1, 2) = "" Then Exit For
    Second_sheet.Cells(I, 2).Resize(15, 3).ClearContents
  Next
If Mal_Femal = "" Then Exit Sub

last_Clas = First_sheet.Cells(Rows.count, 2).End(3).Row
Set find_rg = First_sheet.Rows(4).Find(Second_sheet.Cells(1, 6), lookat:=1)
If find_rg Is Nothing Then Exit Sub
col = find_rg.Column + 8
Mou3addaL = Val(First_sheet.Cells(8, col)) / 2
m = 4: k = 1
 For I = 10 To last_Clas
  If First_sheet.Cells(I, col) < Mou3addaL And _
     First_sheet.Cells(I, 4) = Mal_Femal Then
        If m Mod 19 = 0 Then m = m + 4: k = 1
          With Second_sheet.Cells(m, 2)
            .Value = k
            .Offset(, 1) = First_sheet.Cells(I, 3)
            .Offset(, 2) = First_sheet.Cells(I, 6)
          End With
     m = m + 1: k = k + 1
   End If
Next
  Application.EnableEvents = True
End Sub


الملف (نموذج)

 
 
 
  Ligann.xlsm   تحميل xlsm مرات التحميل :(8)
الحجم :(1563.771) KB


28-11-2020 02:37 مساء
مشاهدة مشاركة منفردة [2]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 237
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 34
قوة السمعة : 2349
عدد الإجابات: 31
 offline 
look/images/icons/i1.gif لجان الدور الثاني حسب المادة وحسب الجنس
السلام عليكم ورحمة الله
جرب هذا التغيير ربما يعجبك
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 
 
 
  لجان الدور الثاني حسب الجنس.xlsm   تحميل xlsm مرات التحميل :(13)
الحجم :(1448.679) KB


29-11-2020 09:05 مساء
مشاهدة مشاركة منفردة [3]
Khairi
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 11-11-2017
رقم العضوية : 1466
المشاركات : 181
الجنس : ذكر
تاريخ الميلاد : 20-12-1973
يتابعهم : 7
يتابعونه : 6
قوة السمعة : 116
 offline 
look/images/icons/i1.gif لجان الدور الثاني حسب المادة وحسب الجنس
مشكورين اساتذتي الكرام وبارك الله فيكم



الكلمات الدلالية
لجان ، الدور ، الثاني ، المادة ، وحسب ، الجنس ،


 










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

الساعة الآن 08:20 صباحا