ناصر سعيد

حفظكم ربنا ورعاكم الاستاذ ياسر خليل والاستاذ محمد صالح

جزاك الله كل خير

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

يبدو انها مشكله في المنتدى لان نفس الاعدادات دي عندي وايضا لاتظهر او ايه الحل ؟

شهادات رائعه بمعايير مختلفه - شهادات الناجحين - شهادات الراسبين - شهادات الولاد - شهادات البنات - شهادات محدده للمحترمه ساجده العزاوي العراقيه شهادات الطلاب بمعايير مختلفه .. لساجده العزاوي.rar

للرفع رفع الله كقداركم

اريد فلترة الفصول لتظهر في ورقه شهاده1 فنعمل منها قائمه منسدله ليتم استخراج الشهادات بمعيه اسم الفصل ولا ادري لما ذا يتم معك هذا بالنسبه للملف اخي الكريم بن عليه

للرفع رفع الله مقداركم

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

حصرياً ولأول مرة كيفية استخراج الناجحين باستخدام المصفوفات ;" >https://youtu.be/F9fA5eQb6js * إذا أعجبتك القناة لا تنسى عمل اشتراك بالقناة Subscribe ، وعمل إعجاب بالفيديوهات Like Extract Pass Using Arrays YasserKhalil LOF.rar

مجموعة ملفات اكسيل ننشرها للفائدة ________________________ ترحيل البيانات بثلاث طرق ;" >https://www.file-upload.com/2nhzuwlz5k60 ادخال-تعديل-حذف-بحث-تقارير ;" >https://www.file-upload.com/bgulqim4px23 عرض التاريخ والوقت على الفورم باكثر من شكل ;" >https://www.file-upload.com/2dgugdr8ta5d اختبر سرعتك في الكتابة ;" >https://www.file-upload.com/wuy1l3x3tjd3 دالة معرفة لاستخراج مواد الرسوب ;" >https://www.file-upload.com/1ckhlnu5kp31 مسح البيانات بمعلومية اللون والخط ;" >https://www.file-upload.com/lvlypc5snw2v استخراج حالة الطالب ومواد الرسوب بالاكواد ;" >https://www.file-upload.com/dif22teab7xb كود بحث بالمصفوفات في عمود واحد ;" >https://www.file-upload.com/ywhf1btu5phy برنامج مخازن بسيط ;" >https://www.file-upload.com/dg0d5uum7opi تقسيم قاعدة بيانات الى كروت صنف ;" >https://www.file-upload.com/x39lx10iit8z الدالة sumifs للجمع بين تاريخين باكثر من شرط ;" >https://www.file-upload.com/y78qqpkgaf4u برنامج لتسجيل حركة الاصناف بالفيجوال6 والاكسيل ;" >https://www.file-upload.com/zopcn02qqjr7 تحديد عدد نسخ الطباعة بالفورم ;" >https://www.file-upload.com/7sf50kn0kmvt الغاء الدمج وتكرار البيانات في الخلايا الفارغة ;" >https://www.file-upload.com/pgl50f274ukv جمع القيم السالبة والموجبة كل على حدا بالدالة sumif ;" >https://www.file-upload.com/ut7qwy69def3 فصل البيانات من خليه الى عدة خلايا ;" >https://www.file-upload.com/jkyorxoiypdy لغز ;" >https://www.file-upload.com/ynb3z140wu24 _______________________ انتظرونا مع مجموعة اخرى تحياتي هذا ملف البحث في عمود بالمصفوفات للمحترم ياسر العربي وفيه عندما يستخرج البيانات يكتبها مرتين في صفحة النتيجه https://gulfsup.com/560628x ============== رجاء من كل واحد ينجح في تحميل ملف من موقع الابلود يعيد تحميله على موقع اخر نضيف وسريع

Const studentData As String = "رصد الترم الثانى" Const shehada As String = "شهادة1" 'هذا الكود للمحترم ياسر خليل 'جزاه الله خيرا 'الهدف من الكود هو الفلتره Private Sub Worksheet_Activate() 'Application.Calculation = xlCalculationManual Application.ScreenUpdating = False 'Application.EnableEvents = False Application.DisplayAlerts = False Sheets(shehada).Range("U:U").ClearContents Sheets(studentData).Range("D7:D500").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Sheets(shehada) _ .Range("U5"), Unique:=True 'Sheets(Shehada).Range("Y4").Value = "الكل" With Sheets(shehada).Range("U5") .Interior.Pattern = xlSolid .Interior.Color = 65535 .Borders.LineStyle = xlContinuous .Borders.Weight = xlThin .Font.Size = 16 End With With Sheets(shehada).Range("U5:U15") .Interior.Pattern = xlSolid .Interior.ColorIndex = 0 .Borders.LineStyle = xlContinuous .Borders.Weight = xlThin .Font.ColorIndex = 0 .Font.Size = 16 End With Application.DisplayAlerts = True ' Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True ' Application.EnableEvents = True End Sub هذا هو الكود الذي لايعمل في ملفي .. لماذا لااعرف

للرفع

استدعاء بيانات اعمده معينه بطريقه المصفوفات للاستاذ المحترم زيزو العجوز جزاه الله كل خير وبارك له Sub TransData1() 'هذا الكود للمحترم زبزو العجوز 'الهدف من الكود ترحيل بيانات بمعلوميه خليه 'تم هذا الكود في 19/4/2017 '======== ' Dim ws As Worksheet, sh As Worksheet 'اعلان عن متغير شيت الهدف Set ws = Sheets("M_SH") 'اعلان عن متغير شيت المصدر Set sh = Sheets("SH") Dim Arr As Variant, Arr1 As Variant, temp As Variant Dim LR As Long, i As Long, j As Long, p As Long 'سطر لعد الصفوف في شيت المصدر LR = WorksheetFunction.CountA(sh.Range("D10:D10000")) 'سطر لمسح النطاق ws.Range("A9:AJ1000").ClearContents Arr = sh.Range("A10:DD" & LR).Value Arr1 = Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 16, 17, 26, 27, 36, 37, 47, _ 48, 59, 60, 67, 68, 71, 72, 76, 77, 81, 82, 86, 87, 91, 92, 97, 98, 105) ReDim temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For i = 1 To UBound(Arr) 'سطر اذا كانت قيمه الخليه بي 1 مكتوب فيها شيت نصف العام If ws.Range("B1").Value = "شيت نصف العام ـ الصف الرابع الابتدائى" Then p = p + 1 For j = 0 To UBound(Arr1) temp(p, j) = Arr(i, Arr1(j)) ws.Cells(p + 8, 1) = p Next j End If Next i If p > 0 Then ws.Range("B9").Resize(p, UBound(temp, 2)).Value = temp End Sub Sub TransData2() Dim ws As Worksheet, sh As Worksheet Set ws = Sheets("M_SH") Set sh = Sheets("SH") Dim Arr As Variant, Arr2 As Variant, temp2 As Variant Dim LR As Long, i As Long, j As Long, p As Long LR = WorksheetFunction.CountA(sh.Range("D10:D10000")) ws.Range("A9:AJ1000").ClearContents Arr = sh.Range("A10:DD" & LR).Value Arr2 = Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 22, 23, 32, 33, 42, 43, 55, 56, 65, 66, _ 69, 70, 74, 75, 79, 80, 84, 85, 89, 90, 93, 94, 103, 104, 107) ReDim temp2(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr2) + 1) For i = 1 To UBound(Arr) If ws.Range("B1").Value = "شيت آخر العام ـ الصف الرابع الابتدائى" Then p = p + 1 For j = 0 To UBound(Arr2) temp2(p, j) = Arr(i, Arr2(j)) ws.Cells(p + 8, 1) = p Next j End If Next i If p > 0 Then ws.Range("B9").Resize(p, UBound(temp2, 2)).Value = temp2 End Sub Using Arrays.rar ========================== جزاكم الله كل خير

الاستاذ المحترم بن عليه ربنا يبارك فيك ويجزيك خيرا الملف حجمه اكبر من تحميل على المنتدى تم تحميل الملف على موقع اخر والملف ان شاء الله نظيف https://gulfsup.com/ace79ax

يحفظك ربنا استاذ محمد صالح عوده ان شاء الله حميده

السلام عليكم ورحمة الله في هذا الملف كود في حدث صفحه شهاده 1 خاص بالفلتره ولكنه لايعمل في هذا المرفق كلمات السر والمستخدم 1 برجاء تضبيطه https://up.top4top.net/downloadf-47498nnd1-rar.html

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

جزاك الله كل خير وبارك لك استاذ ياسر خليل

اخي الكريم استاذ ياسر خليل جزاك الله الف الف خير وبارك فيك السطرين لم يؤدو الغرض ==== في شهادات الفصول خرجت شهادات الناجحين من الفصل فقط

Sub فصـــول_1() Const StudentData As String = "رصد الترم الثانى" Const Shehada As String = "شهادة" Dim strClass As String strClass = Sheets(Shehada).Range("W2").Value lr = Sheets(StudentData).Range("C7").End(xlDown).Row c = 2 Application.ScreenUpdating = False x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel) If x = vbYes Then b = True ElseIf x = vbNo Then b = False ' strClass = InputBox("أدخل الفصل") ' If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then ' MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub ' End If ' Else ' MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub End If For i = 7 To lr If c Mod 2 = 0 Then If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 End If GoTo 1 Else If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 Sheets(Shehada).Range("A1:P31").PrintOut Sheets(Shehada).Cells(3, 13) = "" Sheets(Shehada).Cells(19, 13) = "" End If End If 1: Next i If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then Sheets(Shehada).Range("A1:P15").PrintOut End If Application.ScreenUpdating = True End Sub جزاك الله الف الف خير استاذ ياسر تاتي باناجحين الفصل فقط اذا اخترنا لا اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان ) ===== نريدها اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان )

Sub فصـــول_1() Const StudentData As String = "رصد الترم الثانى" Const Shehada As String = "شهادة" Dim strClass As String strClass = Range("W2").Value lr = Sheets(StudentData).Range("C7").End(xlDown).Row c = 2 Application.ScreenUpdating = False x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel) If x = vbYes Then b = True ElseIf x = vbNo Then b = False ' strClass = InputBox("أدخل الفصل") If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub End If Else MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub End If For i = 7 To lr If c Mod 2 = 0 Then If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 End If GoTo 1 Else If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 Sheets(Shehada).Range("A1:P31").PrintOut Sheets(Shehada).Cells(3, 13) = "" Sheets(Shehada).Cells(19, 13) = "" End If End If 1: Next i If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then Sheets(Shehada).Range("A1:P15").PrintOut End If Application.ScreenUpdating = True End Sub هل يكون بهذا الشكل يا استاذ ياسر حفظك الله ؟ لانها لم تعمل معي معذره

جزاك الله كل خير وبارك فيك استاذ ياسر خليل

ربنا يبارك لك استاذ ياسر خليل لوفيه خليه وفيها قائمه منسدله بالفصول .. هاتكون اسهل من الكتابه لتطابق اسم الفصل في القائمه المنسدله ربنا يكتبها في كفة حسناتك

لا يا اخي لايوجد حل لهذا الكود حتى الان