asdhamdey

هذا هو المرفق الشيت.rar الذي نريد تطبيق الكود عليه

Sub ناجحين() Dim c As Range For Each c In Sheet1.Range("case") If c.Value = "ناجح" Then Z = Z + 1 lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1 Sheet2.Range(Sheet2.Cells(lstrow, "b"), Sheet2.Cells(lstrow, "ag")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")).Value Sheet2.Cells(lstrow, "a") = Z: End If Next c End Sub المحترم استاذ ابو عبد الباري لو تكرمت نريد شرحه

اخي الكريم جزاك الله كل خير وبركه .. وبعد الاروع ان تشرح لنا كيفيه الاستفاده من هذا العمل المتميز في اعمال اخرى .. ماهي المتغيرات فيه حتى يسهل الاستفاده منه والدعاء لكم بطيبه حينما غيرت اسماء المستفيدين وضغط على الزر لم يظهر الاسم الجديد

=IF(B5="";"";IF(AND((COUNTIFS(C5:AX5;"غائب")=0);(COUNTIFS(C5:AX5;"دون المستوى")=0));"ناجح";"راسب")) انظر الى المعادلة (هذا العمل للمحترم الاستاذ محمد ابو البراء ) لو لاحظنا في هذه الدالة سنجد ان االدالة ليس فيها الا نطاق واحد متكرر مرتان وهو c5:ax5 هذا النطاق هو نطاق اول طالب فيه تقديراته من اول مادة الى اخر مادة فبالتالي اذا اردنا استخدامها نستطيع وبسهولة وكل ما علينا الا تغيير هذا النطاق ليتناسب مع عدد موادنا دالة بطريقة جديدة لمعرفة حالة الطالب _راسب او ناجح. =IF(B5="";"";IF(COUNTIF(C5:AX5;"غائب")+COUNTIF(C5:AX5;"دون المستوى")=0;"ناجح";"راسب")) للاستاذ المحترم جمال عبد السميع دالة بطريقة جديدة لمعرفة حالة الطالب _راسب او ناجح. ====================================================== ====================================================== شرط النجاح للطالب ان يكون حاصل علة 30% من درجه امتحان اخر العام ان يكون الطالب حاصل على نصف او اكبر من نصف درجة المجموع لنفس الماده لايكون غائب في امتحان اخر العام لنفس الماده abo_abary_Book1.ra =IF(OR(H13<$H$10;H13="غ";I13<$I$10);"راسبة";"ناجحة")

=IF(OR(H13<$H$10;H13="غ";I13<$I$10);"راسبة";"ناجحة") تمام التمام حفظك الله استاذ ابو عبد الباري

بارك الله في حضرتك وجعل الله جميع أعمالك في موازين حسناتك ...

بارك الله في حضرتك وجعل الله جميع أعمالك في موازين حسناتك ...

بارك الله في حضرتك وجعل الله جميع أعمالك في موازين حسناتك ...

بارك الله فيكم

Option Explicit Sub UniqueSortedList() Dim Arr, X As Object Application.ScreenUpdating = False With CreateObject("System.Collections.ArrayList") Set X = .Clone: X.Add " " Sheets("بيانات الطلبة").Activate For Each Arr In Sheets("بيانات الطلبة").Range("V7", Range("V" & Rows.Count).End(xlUp)).Value If Arr <> "" Then If IsNumeric(Arr) Then If Not .Contains(Arr) Then .Add Arr Else If Not X.Contains(Arr) Then X.Add CStr(Arr) End If End If Next .Sort: X.Sort: .addRange X: Arr = Join(.ToArray, ",") End With Sheets("الاوائل").Activate With Sheets("الاوائل").Range("S7").Validation .Delete .Add xlValidateList, 1, 1, Arr End With Application.ScreenUpdating = True End Sub كود قائمه متسدله بون تكرار ومرتبه تصاعديا للاستاذ المحترم ياسر خليل قائمه منسدلة ديناميكية مطاطية بدون تكرار اى بند فيها Unique Sorted Validation List.rar

Sub Tarhil_Ragab() 'تعريف المتغيرات Dim Sh As Worksheet Dim strSh As String Dim I As Long Dim AA As Long 'سطر لإيقاف تحديث الشاشة Application.ScreenUpdating = False 'مسح محتويات النطاق في ورقة العمل ناجح Sheets("ناجح").Range("A12:X1000").ClearContents 'مسح محتويات النطاق في ورقة العمل دور ثان Sheets("دور ثان").Range("A12:X1000").ClearContents 'مسح محتويات النطاق في ورقة العمل راسب Sheets("راسب").Range("A12:X1000").ClearContents 'بدء التعامل مع ورقة العمل الأولى التي تعتبر الورقة الرئيسية With Sheet1 '[Y] حلقة تكرارية بدايةً من الصف الـ 12 وحتى آخر صف به بيانات بالاعتماد على العمود For I = 12 To .Cells(10000, "Y").End(xlUp).Row '[Y] تعيين قيمة المتغير ليساوي قيمة الخلية في الصف المحدد في العمود 'ففي أول حلقة تكرارية سيكون الصف هو رقم 12 [I] المقصود بالصف المحدد الصف الذي يحمل قيمة المتغير 'وفي الحلقة التالية سيكون الصف رقم 13 وهكذا مع كل حلقة تكرارية يتغير الصف strSh = .Cells(I, "Y").Value 'تعيين المتغير ليساوي آخر صف في الورقة التي سيتم الترحيل إليها 'أو يمكنك القول معرفة رقم صف أول صف فارغ AA = Sheets(strSh).Cells(10000, 2).End(xlUp).Row + 1 'إذا كان المتغير أقل من 12 الذي من المفترض أنه صف البداية لعمليات الترحيل فإنه يتم تعيين المتغير ليساوي 12 If AA < 12 Then AA = 12 'في حالة حدوث خطأ يتم تجنبه بهذا السطر On Error Resume Next 'نسخ النطاق في الصف المحدد من العمود الثاني إلى العمود الرابع والعشرون .Range(.Cells(I, "B"), .Cells(I, "X")).Copy 'لصق النطاق المنسوخ إلى ورقة العمل المناسبة واللصق يكون لصق قيم فقط Sheets(strSh).Range("B" & AA).PasteSpecial xlPasteValues 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False 'هذا السطر يقوم بترقيم الصف الذي تم ترحيله في الورقة الهدف 'حيث يعتمد على إنقاص 11 من رقم الصف الحالي 'فإذا كان الصف الحالي هو رقم 12 ألا وهو رقم البداية فإن الرقم 'المسلسل سيكون 12 - 11 أي سيكون الرقم المسلسل 1 Sheets(strSh).Cells(AA, "A").Value = Sheets(strSh).Cells(AA, "A").Row - 11 'الانتقال للصف التالي في الحلقة التكرارية Next I 'حلقة تكرارية لكل أوراق العمل لتحديد الخلية الأولى في ورقةالعمل For Each Sh In ThisWorkbook.Worksheets Application.Goto Sh.Range("A1") Next Sh 'تنشيط ورقة العمل الأولى .Activate 'انتهاء التعامل مع ورقة العمل الأولى End With 'سطر لإعادة تفعيل اهتزاز الشاشة Application.ScreenUpdating = True 'إظهار رسالة تفيد بانتهاء عمل الكود MsgBox "تم الفصل بنجاح", 64 End Sub

Sub Tarhil_Ragab() 'تعريف المتغيرات Dim Sh As Worksheet Dim strSh As String Dim I As Long Dim AA As Long 'سطر لإيقاف تحديث الشاشة Application.ScreenUpdating = False 'مسح محتويات النطاق في ورقة العمل ناجح Sheets("ناجح").Range("A12:X1000").ClearContents 'مسح محتويات النطاق في ورقة العمل دور ثان Sheets("دور ثان").Range("A12:X1000").ClearContents 'مسح محتويات النطاق في ورقة العمل راسب Sheets("راسب").Range("A12:X1000").ClearContents 'بدء التعامل مع ورقة العمل الأولى التي تعتبر الورقة الرئيسية With Sheet1 '[Y] حلقة تكرارية بدايةً من الصف الـ 12 وحتى آخر صف به بيانات بالاعتماد على العمود For I = 12 To .Cells(10000, "Y").End(xlUp).Row '[Y] تعيين قيمة المتغير ليساوي قيمة الخلية في الصف المحدد في العمود 'ففي أول حلقة تكرارية سيكون الصف هو رقم 12 [I] المقصود بالصف المحدد الصف الذي يحمل قيمة المتغير 'وفي الحلقة التالية سيكون الصف رقم 13 وهكذا مع كل حلقة تكرارية يتغير الصف strSh = .Cells(I, "Y").Value 'تعيين المتغير ليساوي آخر صف في الورقة التي سيتم الترحيل إليها 'أو يمكنك القول معرفة رقم صف أول صف فارغ AA = Sheets(strSh).Cells(10000, 2).End(xlUp).Row + 1 'إذا كان المتغير أقل من 12 الذي من المفترض أنه صف البداية لعمليات الترحيل فإنه يتم تعيين المتغير ليساوي 12 If AA < 12 Then AA = 12 'في حالة حدوث خطأ يتم تجنبه بهذا السطر On Error Resume Next 'نسخ النطاق في الصف المحدد من العمود الثاني إلى العمود الرابع والعشرون .Range(.Cells(I, "B"), .Cells(I, "X")).Copy 'لصق النطاق المنسوخ إلى ورقة العمل المناسبة واللصق يكون لصق قيم فقط Sheets(strSh).Range("B" & AA).PasteSpecial xlPasteValues 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False 'هذا السطر يقوم بترقيم الصف الذي تم ترحيله في الورقة الهدف 'حيث يعتمد على إنقاص 11 من رقم الصف الحالي 'فإذا كان الصف الحالي هو رقم 12 ألا وهو رقم البداية فإن الرقم 'المسلسل سيكون 12 - 11 أي سيكون الرقم المسلسل 1 Sheets(strSh).Cells(AA, "A").Value = Sheets(strSh).Cells(AA, "A").Row - 11 'الانتقال للصف التالي في الحلقة التكرارية Next I 'حلقة تكرارية لكل أوراق العمل لتحديد الخلية الأولى في ورقةالعمل For Each Sh In ThisWorkbook.Worksheets Application.Goto Sh.Range("A1") Next Sh 'تنشيط ورقة العمل الأولى .Activate 'انتهاء التعامل مع ورقة العمل الأولى End With 'سطر لإعادة تفعيل اهتزاز الشاشة Application.ScreenUpdating = True 'إظهار رسالة تفيد بانتهاء عمل الكود MsgBox "تم الفصل بنجاح", 64 End Sub

Sub printpreview1() 'كود معاينة طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview End Sub Sub print_2() 'كود طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut End Sub كود معاينه طباعة مطاطي وكود طباعة مطاطي

من باب تجميع الاعمال التي تهم المدرسين في مكان واحد Sub Filter() Dim LR As Long With ورقة1 LR = .Cells(.Rows.Count, "D").End(xlUp).Row .Range("c5:y5" & LR).AdvancedFilter xlFilterCopy, Range("aa1:aa2"), Range("c5:y5") End With Range("a1").Select LR = Cells(Rows.Count, "D").End(xlUp).Row ActiveSheet.PageSetup.PrintArea = Range("b2:y" & LR).Address End Sub شرح-كود-الفلتر. Sub kh_Filter() ''''' Dim LR As Long With Sheet2 'يمسح منطقة اخراج البيانات قبل الفلتره من بداية السطر 9 حتي نهاية ترقيم الورقة .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents End With With Sheet1 'لتحديد رقم اخر صف في قاعدة البيانات LR = .Cells(.Rows.Count, "AF").End(xlUp).Row 'كود للتصفية المتقدمة يحدد فيه مدي قاعدة البيانات ومنطقة مدي شروط التصفية وايضا مدي مخرجات ناتج التصفية .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True End With Range("a3").Select 'لتحديد رقم اخر صف في مدي المخرجات LR = Cells(Rows.Count, "AF").End(xlUp).Row 'يقوم بتحديد مدي منطقة طباعه المخرجات ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address End Sub وضعت شرح العملاق عمر الحسيني مع الكود كود فلتره 10. Sub mh() ' ' ماكرو2 ماكرو ' الماكرو مسجل ‎17/06/2016 بواسطة ‎11 ' ' Range("A3:D47").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "f2:f3"), CopyToRange:=Range("H4:K4"), Unique:=False End Sub كود فلتره في نقس الصعحه _الطلبة الضعاف.