ترحيل البيانات بناء علي قيمة في قائمة منسدلة

[ابو بهاء المصري]

منتديا الغالي اوفيسنا
اعضائه الكرام ومشرفيه الاجلاء
تحية طيبة وبعد

لي طلب بسيط لديكم ارجو تلبيته من فضلكم الكريم
اريد ترحيل بيانات من صفحة names الي صفحة اللجان legan بناء علي القيمة المختارة من القائمة المنسدلة

باكتر توضيح (اريد ترحيل الطلبة الراسبون في مادة ما (علي حسب جدول الامتحانات) وهذه المواد الامتحانية موجود في الخلية m3 كقائمة منسلدة في صفحة legan الي كشف في ورقة جديدة وهي الورقة legan كما سوف ترون في الملف المرفق

شاكرا تعب محبتكم

 

لجان الدور الثاني.xls

تم تعديل يونيو 21, 2019 بواسطه ابو بهاء المصري

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

من فضلك حمل الملف في المرة الثانية بدون ألوان فاقعة  تبهر النظر ليستطيع من سيحاول المساعدة على فهم الموضوع

يمكنك تجربة هذا الملف (بعد تعديل بسيط في تنسيقاته)

 

 

 

Legan _salim.xls

[ابو بهاء المصري]

شكرا لتعب حضرتك وانا اسف علي الالوان الفاقعة

[ابو بهاء المصري]

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

[ابو بهاء المصري]

مفيش اي اجابة ليه يا جماعة

[مهند محسن]

قدم لك الأستاذ سليم افضل الإجابات 

ليس هناك افضل من هذا ولا يعلو على إجابة وحل استاذنا الكبير سليم

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

يمكن اذا اردت ان يكون العمل بواسطة الماكرو VBA

Option Explicit

Sub give_data()
Dim N As Worksheet: Set N = Sheets("names")
Dim S As Worksheet: Set S = Sheets("Salim")
Dim lrN%: lrN = N.Cells(Rows.Count, 3).End(3).Row
Dim t%, i%: i = 6
Dim m%: m = 9

S.Cells(m, 3).Resize(15, 7).ClearContents

 Do Until i = lrN + 1
  If N.Cells(i, "Y") Like "*" & S.Range("m3") & "*" Then
    With S.Cells(m, 3)
        t = t + 1
        .Value = N.Cells(i, 1)
        .Offset(, 1) = N.Cells(i, 3)
        .Offset(, 2) = N.Cells(i, 2)
        .Offset(, 3) = N.Cells(i, 5)
        .Offset(, 4) = N.Cells(i, 10)
        .Offset(, 5) = N.Cells(i, 8)
        m = m + 1
    End With
   End If
 i = i + 1
 Loop
 Cells(1, 4) = t
End Sub

الملف مرفق

 

Legan _salim.xlsm

[Ali Mohamed Ali]

أحسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

[ابو بهاء المصري]

استاذ / مهند محسن

مع كامل احترامي وتقديري للاستاذ سليم حاصيبا وانا اعلم قدره جيدا في المنتدي

اولا : انا لست حديث العهد به او بالمنتدي فلقد ساعدني كثيرا ولا انكر فضله ابدا

ثانيا: انظر معي شكل الصفحة والنتائج كيف تظهر

كان لابد ان تكون هناك اداة تحضر طلاب الكشف الثاني والثالث وهكذا ولم يوجد . فقط احضر 15 طالبا من اصل 28 طالب في مادة التفاضل وحساب المثلثات علي سبيل المثال وحدث هذا في كلا الحالتين سواء دوال داخل المصنف او كود VBA . وان كنت افضل الحل الاول

ثالثا: لديا ملفاتي واجري تعديلات عليها بعدما ادرس الدوال واعرف طريقة عملها وحفظتها . ولاكن في هذا الملف وجدت دوال جديدة عليا ومدمجة مع بعضها بطريقة استاذ محترف صعب عليا فهمها

رابعا: انا مبحبش في كل مشكلة ارسل طلبي انا احاول واشوف ازاي واذا صعب علي الامر رفعته لاهل الخبرة

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

ولا يسعني في النهاية الا ذكر حضراتكم جميعا بالشكر والخير دائما

تم تعديل يونيو 25, 2019 بواسطه ابو بهاء المصري

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

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

Option Explicit

Sub give_data()
Dim N As Worksheet: Set N = Sheets("names")
Dim S As Worksheet: Set S = Sheets("Salim")
Dim lrN%: lrN = N.Cells(Rows.Count, 3).End(3).Row
Dim lrS%: lrS = S.Cells(Rows.Count, 3).End(3).Row
Dim t%, i%: i = 6
Dim m%: m = 9

S.Cells(m, 3).Resize(lrS + 10, 8).Clear

 Do Until i = lrN + 1

  If N.Cells(i, "Y") Like "*" & S.Range("m3") & "*" Then
    With S.Cells(m, 3)
        t = t + 1
        .Value = N.Cells(i, 1)
        .Offset(, 1) = N.Cells(i, 3)
        .Offset(, 2) = N.Cells(i, 2)
        .Offset(, 3) = N.Cells(i, 5)
        .Offset(, 4) = N.Cells(i, 10)
        .Offset(, 5) = N.Cells(i, 8)
        m = m + 1
    End With
   End If
 i = i + 1
 Loop
 Cells(1, 4) = t
 If t = 0 Then
 MsgBox "No Studiant for this category"
 Exit Sub
 End If
 lrS = S.Cells(Rows.Count, 3).End(3).Row

 With Range("c9").Resize(lrS - 8, 7)
 .Font.Size = 22
 .Borders.LineStyle = 1
 .Interior.ColorIndex = 35
 .InsertIndent 1
 End With
 Range("RG_TO_COPY").Copy Cells(lrS + 2, 5)
 With Cells(lrS + 3, "g")
 .Formula = "=COUNTIF(F9:F" & lrS & "," & """فرنسي""" & ")"
 .Offset(1).Formula = "=COUNTIF(G9:G" & lrS & "," & """مسلم""" & ")"
 .Offset(2).Formula = "=COUNTIF(H9:H" & lrS & "," & """نظامي""" & ")"
 .Offset(, 2).Formula = "=COUNTIF(F9:F" & lrS & "," & """الماني""" & ")"
 .Offset(1, 2).Formula = "=COUNTIF(G9:G" & lrS & "," & """مسيحي""" & ")"
 .Offset(2, 2).Formula = "=COUNTIF(H9:H" & lrS & "," & """منازل""" & ")"
 End With
End Sub

الملف من جديد

 

Legan _salim _new.xlsm

[مهند محسن]

هذا حقا هو الإبداع بعينه

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

جعله الله في ميزان حسناتك وزادك الله من فضله

[ابو بهاء المصري]

شاكر ليكم تعبكم معي

جعله في ميزان حسناتكم