ناصر سعيد

=IFERROR(INDEX('شيت الرابع الرئيسى'!$A$9:$FH$1000;MATCH($I$5;'شيت الرابع الرئيسى'!$C$9:$C$1000);2);"") المعادله التي تستخدم في الشهاده من الروائع

=IFERROR(INDEX('شيت الرابع الرئيسى'!$A$9:$FH$1000;MATCH($I$5;'شيت الرابع الرئيسى'!$C$9:$C$1000);2);"") المعادله التي تستخدم في الشهاده من الروائع

'****************** ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات ' بمعيار واحد كل 4 شهادات في صفحه واحدة '=*=*=*=*=* Sub اربع_شهادات() Application.ScreenUpdating = False Dim DATA As Worksheet Dim SHEHADA As Worksheet Dim myArray, targt 'اسم صفحة المصدر Set DATA = ThisWorkbook.Worksheets("رصد الترم الثانى") 'اسم صفحة الشهادة Set SHEHADA = ThisWorkbook.Worksheets("4شهادات") 'معيار البحث 'targt = "ناج*" targt = SHEHADA.Range("R7").Value & "*" '********************************* c = 0 lr = DATA.Range("b1000").End(xlUp).Row 'رقم اول صف في صفحة المصدر For i = 7 To lr 'رقم عمود المعيار في صفحة المصدر If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then SHEHADA.Range("M3") = DATA.Cells(i, 2) c = c + 1 'رقم عمود المعيار في صفحة المصدر ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then SHEHADA.Range("M18") = DATA.Cells(i, 2) c = c + 1 'رقم عمود المعيار في صفحة المصدر ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then SHEHADA.Range("M33") = DATA.Cells(i, 2) c = c + 1 ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 3 Then SHEHADA.Range("M48") = DATA.Cells(i, 2) c = c + 1 '=== End If If i = lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p45").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p30").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (SHEHADA.Range("M18") = "" Or SHEHADA.Range("M48") = "") Then GoTo 1 If i < lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut c = 0 Range("M3") = "" Range("M18") = "" Range("M33") = "" Range("M48") = "" 1: Next i Range("M3") = "" Range("M18") = "" Range("M33") = "" Range("M48") = "" Application.ScreenUpdating = True End Sub

Sub ثلاثة_معايير() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل 4 شهادات في صفحه واحدة 'بثلاث معايير '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2, targt3 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("4 شهادات ب3 معايير") '=================== 'targt = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة 'عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then SHEHADA.Range("M48") = DATA.Cells(i, 2) c = c + 1 '=== End If If i = lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p45").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p30").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (SHEHADA.Range("M18") = "" Or SHEHADA.Range("M48") = "") Then GoTo 1 If i < lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut c = 0 Range("M3") = "" Range("M18") = "" Range("M33") = "" Range("M48") = "" 1: Next i Range("M3") = "" Range("M18") = "" Range("M33") = "" Range("M48") = "" Application.ScreenUpdating = True End Sub جزى الله كل من كانت له بصمه في هذا الكود بالخير Sub بمعيارين() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل 4 شهادات في صفحه واحدة 'بمعيارين '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات 'اسم صفحة الهدف Set SHEHADA = Worksheets("4 شهادات بمعيارين") 'اسم الشيت الخاص بالشهادات ' targt = "ناج*" 'targt2 = "ول*" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1 If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut c = 0 Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub

Sub معيار() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل شهادتين في صفحه واحدة 'بمعيار '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات 'اسم صفحة الهدف Set SHEHADA = Worksheets("شهاده ب1معيار") 'اسم الشيت الخاص بالشهادات ' targt = "ناج*" 'targt2 = "ول*" targt = SHEHADA.Range("R7").Value & "*" ' targt2 = SHEHADA.Range("S7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then ' Range("M35") = DATA.Cells(i, 2) ' c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For 'If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1 If i < lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut c = 0 Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub

========= Sub بمعيارين() ' هذا الكود للنابغه ساجده شهاده ب1معيار العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل شهادتين في صفحه واحدة 'بمعيارين '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات 'اسم صفحة الهدف Set SHEHADA = Worksheets("شهاده 2معيار") 'اسم الشيت الخاص بالشهادات ' targt = "ناج*" 'targt2 = "ول*" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then ' Range("M35") = DATA.Cells(i, 2) ' c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For 'If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1 If i < lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut c = 0 Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub

بسم الله الرحمن الرحيم يجزيكم الله خيرا ويبارك فيكم ... آمين هذا كود يعمل جيدا ويبحث في كل الصفحه عن الشهادات المطلوبه ولكني اريد ان يبحث في مدى معين احدده في صفحه اكسيل لاادري عندما اضع هذا الشرط لايعمل الكود ' For i = SHEHADA.Range("U7").Value To SHEHADA.Range("V7").Value ====== وهذا هو الكود كاملا Sub ثلاثة_معايير() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل 3 شهادات في صفحه واحدة 'بثلاث معايير '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2, targt3 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("3 شهادات ب3 معايير") '=================== 'targt = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة 'عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = SHEHADA.Range("U7").Value To SHEHADA.Range("V7").Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1 If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut c = 0 Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub وهذا هو الملف https://up.top4top.net/downloadf-666n9v8u1-rar.html

Sub ثلاثة_معايير() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل شهادتين في صفحه واحدة 'بثلاث معايير '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2, targt3 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("شهاده 3معيار") '=================== 'targt = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة 'عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then ' Range("M35") = DATA.Cells(i, 2) ' c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For 'If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1 If i < lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut c = 0 Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" ' Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub جزى الله كل من كانت له بصمه في هذا الكود .. بالخير

'****************** ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات ' بمعيار واحد كل 3 شهادات في صفحه واحدة '=*=*=*=*=* Sub تلات_شهادات() Application.ScreenUpdating = False Dim DATA As Worksheet Dim SHEHADA As Worksheet Dim myArray, targt 'اسم صفحة المصدر Set DATA = ThisWorkbook.Worksheets("رصد الترم الثانى") 'اسم صفحة الشهادة Set SHEHADA = ThisWorkbook.Worksheets("3شهادات") 'معيار البحث 'targt = "ناج*" targt = SHEHADA.Range("R7").Value & "*" '********************************* c = 0 lr = DATA.Range("b1000").End(xlUp).Row 'رقم اول صف في صفحة المصدر For i = 7 To lr 'رقم عمود المعيار في صفحة المصدر If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then SHEHADA.Range("M3") = DATA.Cells(i, 2) c = c + 1 'رقم عمود المعيار في صفحة المصدر ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then SHEHADA.Range("M19") = DATA.Cells(i, 2) c = c + 1 'رقم عمود المعيار في صفحة المصدر ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then SHEHADA.Range("M35") = DATA.Cells(i, 2) c = c + 1 End If If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (SHEHADA.Range("M19") = "" Or SHEHADA.Range("M35") = "") Then GoTo 1 If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut c = 0 Range("M3") = "" Range("M19") = "" Range("M35") = "" 1: Next i Range("M3") = "" Range("M19") = "" Range("M35") = "" Application.ScreenUpdating = True End Sub ============= جزى الله كل من كانت له بصمه في هذا الكود بالخير

Sub بمعيارين() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل 3 شهادات في صفحه واحدة 'بمعيارين '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات 'اسم صفحة الهدف Set SHEHADA = Worksheets("3 شهادات بمعيارين") 'اسم الشيت الخاص بالشهادات ' targt = "ناج*" 'targt2 = "ول*" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1 If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut c = 0 Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub جزى الله كل من كانت له بصمه في هذا الكود

Sub ثلاثة_معايير() ' هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'الهدف من الكود هو استخراج الشهادات 'كل 3 شهادات في صفحه واحدة 'بثلاث معايير '=*=*=*=*=* Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt, targt2, targt3 As String 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("3 شهادات ب3 معايير") '=================== 'targt = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة 'عن التوزيع في ورقة مصدر البيانات 'هذا السطر في حال شهادات الكل For i = 7 To lr 'هذا السطر في حال طلب شهادات محدده ' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value '======= If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '=== ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '=== End If ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1 If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut c = 0 Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" 1: Next i Range("M3") = "" Range("M19") = "" Range("M35") = "" ' Range("M51") = "" Application.ScreenUpdating = True End Sub جزى الله كل من كانت له بصمه في هذا الكود

الاستاذ محمود الشريف جزاه الله خيرا شرح الكود الخاص به لتوزيع الفصول وهذا هو المرفق إنشاء قوائم الفصول1.rar ==================== Sub MZM_START() ' الاعلان عن المتغيرات وعددهم خمسة Dim MyRange As Range Dim R As Integer, C As Integer, M As Integer, Y As Integer, t As Integer 'تعريف مدى البيانات بشيت بيانات الطلبة الذى يتم جلب البيانات منه '='بيانات الطلبة'!$A$10:$AK$1009 'بإسم school Set MyRange = Range("School") Application.Calculation = xlCalculationManual Application.ScreenUpdating = False '================================= ' مسح البيانات 'استدعاء كود مسح البيانات بشيت قوائم الفصول 'لإستقبال البيانات الجديدة وهذا المدى تم تحديده داخل الكود '("B11:L60") MZM_ClearContents '================================= ' فرز School 'استدعاء كود الفرز للبيانات بشيت بيانات الطلبة MZM_Sort '================================= 'تم وضع شرط إضافة نصف عدد الفصل بالخلية 'E2 'وفى حال عدم وجود بيانات بتلك الخلية يتم التنفيذ بناء على شرط افتراضى 'أن نصف عدد الفصل يساوى 50 طالب 'نلاحظ أنه فى حالة عدم ادخال رقم بهذه الخلية سيتم جلب البيانات داخل قائمة واحدة 'ولن يتم قسمة عدد إجمالى طلاب الفصل على قائمتين If IsEmpty(Range("E2")) Or IsNumeric(Range("E2")) = False Then t = 50 Else t = Range("E2").Value 'تحديد صف رؤوس الجدول بالصف العاشر C = 10 With MyRange 'بداية حلقة تكرارية لجلب البيانات المطلوبة مع وضع شروط لها كالتالي For R = 1 To .Rows.Count If .Cells(R, 2) <> "" Then ' اضافة شرط ان العمود الرابع بشيت بيانات الطلبة يتوافق مع رقم الفصل المطلوب بالخلية 'L2 'الموجود بها قائمة الفصول بشيت قوائم الفصول If .Cells(R, 4).Text = Range("L2").Text Then 'وضع شرط فى حال توافر بيانات بالخلية 'J2 'القائمة المنسدلة الخاصة بالنوع ذكر أم أنثى يعمل الكود على أساسها 'فى حال عدم توافر بيانات بها يستمر الكود فى عمله 'شرط أن تتوافق الخلية مع العمود رقم 18 بالشيت الرئيسى If Range("J2").Text = "" Then GoTo 1 If .Cells(R, 18).Text = Range("J2").Text Then 1 If M >= t Then Y = 6: M = 0 M = M + 1 'تم اضافة شرط خاص بتنسيق الجدول حسب تواجد رؤوس الأعمدة بشيت قوائم الفصول 'نقول فيه أن 'Y = 6 'أى أن عدد أعمدة كل قائمة من القائمتين بشيت قوائم الفصول والتى يتم جلب بيانات فيها عددها 6 أعمدة If Y = 6 Then Cells(C + M, Y + 2) = M + t Else Cells(C + M, Y + 2) = M 'العمود الثالث بشيت قوائم الفصول يتم جلب البيانات إليه من العمود الثاني بشيت بيانات الطلبة 'مع ملاحظة أنه حسب الشروط فى حالة توافق شرط نصف عدد الطلاب حسب الخلية 'E2 'يتم قسمة عدد الطلاب على القائمتين بحيث أن العمود الثالث بشيت قوائم الفصول سيتم 'استكمال البيانات بالعمود التاسع بشيت قوائم الفصول 'وهذا ما تعنية 'Y + 3 'وهكذا فى باقي الأعمدة Cells(C + M, Y + 3) = .Cells(R, 2) 'العمود الرابع بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 17 بشيت بيانات الطلبة Cells(C + M, Y + 4) = .Cells(R, 17) 'العمود الخامس بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 11 بشيت بيانات الطلبة Cells(C + M, Y + 5) = .Cells(R, 11) 'العمود السادس بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 7 بشيت بيانات الطلبة Cells(C + M, Y + 6) = .Cells(R, 7) End If End If End If Next R End With '================================= 'اخفاء الصفوف المتبقية من التعيين If t = 50 Then GoTo 2 With Range("B11:L60") 'يتم اخفاء الصفوف الفارغة والتى زادت عن نصف عدد الفصل من الطلاب والذى تم تحديده بـ 50 .Offset(t, 0).Resize(50 - t).EntireRow.Hidden = True End With '================================= Application.Calculation = xlCalculationAutomatic 2 Application.ScreenUpdating = True End Sub Sub MZM_ClearContents() 'يتم مسح هذا المدى لتجهيز الشيت لإستقبال بيانات جديدة 'مع إظهار الصفوف التى تم إخفاؤها With Range("B11:L60") .ClearContents .EntireRow.Hidden = False End With End Sub Sub MZM_Sort() 'عملية فرز للمدى المحدد بإسم 'School 'بشيت بيانات الطلبة بالعمودين 'A , B With Range("School") .Sort .Columns("A:A"), xlAscending .Sort .Columns("B:B"), xlDescending End With End Sub

توزيع اللجان المدرسيه بالطباعه لجان كنترول مدرسي.rar Sub طباعة_الكشوف() 'طباعه كشوف اللجان دفعه واحده 'للمحترم احمد كامل '==== Range("F1").Select ActiveCell.FormulaR1C1 = "1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 2 Legan_Test ActiveWindow.SelectedSheets.PrintOut Loop While ActiveCell.Value <= Range("E1").Value Range("b1").Select End Sub =====

الاستاذ المحترم الذي اكن له كل تقدير واحترام ابن عليه حاجي يحفظه الله مشاركاتك دائما دسمه يرعاك الله ======= =MATCH(9^9;$A:$A;1) ال9 هنا ماذا تدل ؟ وهل هي شرط كتابتها بهذه الصوره ام يمكن اختيار رقم تان علامه الاس اللي بعد ال 9 كيف اكتبها .. اضغط على ايه في لوحه المفاتيح ؟ ======== وا ل 1 ماذا يدل ؟

رابط عمل شهادتين كل صفحه

رابط عمل شهادتين كل صفحه

رابط عمل 4 شهادات كل صفحه ر ابط عمل 3 شهادات كل صفحه

بسم الله الرحمن الرحيم احبابنا في الله ادعو الله ان تكونوا بخير يارب هذا ملف به كود خاص باخراج شهادات الطلاب كل 2 شهاده في صفحه وما أسهله الكود للنابغه ساجده العزاوي طريقه الاستفاده من هذا الملف افتح هذا الملف اضغط على زر ALT وانت ماتزال ضاغط اضغط على F11 سيتم فتح محرر الاكواد .. ستجد امامك موديولات بها الاكواد دبل كليك على اول موديول ثم اضغط من لوحة المفاتيح على ALT +SHEFT لتكون اللغه هي العربيه منعا لظهور اللغه العربيه بشكل طلاسم اجعل مؤشر الماوس في الكود ثم اضغط CTRL +A لتحديد الكود كله ثم CTRL+C ليتم النسخ ===== ** افتح ملفك وافتح محرر الاكواد كما اشرنا سابقا ** ومن قائمه محرر الاكواد التي فتحت امامك ** اختر Insert واختر منها Module ** ثم ضع المؤشر في Module ** والصق الكود ========== ماهي التغييرات التي تحدثها في الكود حتى يكون صالحا للاستعمال ؟ ** غير اسم صفحه مصدر البيانات ** غير اسم صفحة الشهادات ** غير رقم عمود المعيار ========= احمد الله وادعو لكل من له بصمه في اخراج هذا العمل بالخير يكفي جملة جزاكم الله خيرا **** في صفحه الشهادات يوجد خليه R7 و S7 و T7 في حاله شهادات المعيار الواحد نستطيع ان ننستدعي شهادات الناجحين كلهم او اللي عندهم دور تان كلهم بمجرد كتابه ( نا ) اختصار كلمه ناجح او (دور ) اختصار كلمه دور تان ************** اما الشهادات ذات المعيارين ففي الخليه R7 نكتب كلمه (نا ) اختصار كلمه ناجح او ( دور ) اختصار كلمه دور تان وفي الخليه S7 نكتب ( ول) اختصار كلمه ولد او نكتب (بن) اختصار كلمه بنت وهكذا نكون استطعنا ان نستدعي شهادات الاولاد الناجحين او الاولاد اللي عندهم دور تان او البنات الناجحين او البنات اللي عندهم دور تان ************** اما الشهادات ذات الثلاثه معايير ففي الخليه R7 نكتب كلمه (نا ) او ( دور ) وفي الخليه S7 نكتب ( ول ) اختصار كلمه ولد او نكتب ( بن ) اختصار كلمه بنت وفي الخليه T7 نكتب الفصل (3/1 ) مثلا وهكذا نكون استطعنا ان نستدعي شهادات الاولاد الناجحين في فصل معين او الاولاد اللي عندهم دور تان في فصل معين او البنات الناجحين في فصل معين او البنات اللي عندهم دور تان في فصل معين ************** يكفي جملة جزاكم الله خيرا شهادتين في صفحه ... رائعه النابغه.rar ************** رابط اخر http://gulfup.co/max5s2kmcikt ================= رابط شرح بالفيديو من النابغه ساجده العزاوي من العراق اعز الله العراق واذل اعداءه قناة ساجدة العزاوي التعليمية print excel vba طباعة شهادات الطلاب sajida alazzawi رابط ملف التطبيق http://www.mediafire.com/file/434sjdj... رابط صفحة الفيس بوك https://www.facebook.com/sajidaalazza... ساهم في نشر قناتنا على مواقع التواصل الاجتماعي بدون التجاوز على خصوصيات الاخرين

الملف النهائي وبه كود للطباعه ============= لجان كنترول مدرسي1.rar ==========

============== الملف النهائي لجان كنترول مدرسي1.rar ========== Sub Legan_Test() '**************** 'الكود للمحترم خالد الرشيدي 'وتعديل المحترم ياسر خليل 'الهدف من الكود هو توزيع الطلاب على اللجان المدرسيه 'تم هذا الكود في اكتوبر 2017 '**************** Dim Main As Worksheet Dim sh As Worksheet Dim arr As Variant Dim arrC As Variant Dim temp1 As Variant Dim temp2 As Variant Dim lr As Long Dim i As Long Dim j As Long Dim k As Long Dim p1 As Long Dim p2 As Long Set Main = Sheets("بيانات الطلبة") Set sh = Sheets("كشوف المناداة ") lr = Main.Cells(Rows.Count, 5).End(xlUp).Row Application.ScreenUpdating = False sh.Range("C10:F39").ClearContents sh.Range("K10:N39").ClearContents sh.Rows("10:39").Hidden = False arr = Main.Range("A7:V" & lr).Value 'رقم الاعمده المراد ترحيلهافي صفحه المصدر arrC = Array(2, 5, 15, 16) ReDim temp1(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) ReDim temp2(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) For i = 1 To UBound(arr) 'رقم عمود رقم اللجنه للطالب في صفحه المصدر If arr(i, 18) = sh.Range("E3").Value Then p1 = p1 + 1 For j = 0 To UBound(arrC) temp1(p1, j) = arr(i, arrC(j)) Next j End If 'رقم عمود رقم اللجنه للطالب في صفحه المصدر If arr(i, 18) = sh.Range("M3").Value Then p2 = p2 + 1 For j = 0 To UBound(arrC) temp2(p2, j) = arr(i, arrC(j)) Next j End If Next i If p1 > 0 Then sh.Range("C10").Resize(p1, UBound(temp1, 2)).Value = temp1 If p2 > 0 Then sh.Range("K10").Resize(p2, UBound(temp2, 2)).Value = temp2 If p1 > 0 Then k = p1 If p2 > 0 And p2 > k Then k = p2 k = k + 10 If k < 39 Then sh.Rows(k & ":39").Hidden = True '=============================== 'بعض التنسيقات في اللجنه With ActiveSheet.Range("C10:N39") .EntireColumn.NumberFormat = "@" .Font.Bold = True .ReadingOrder = xlRTL: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter End With '=============================== Application.Visible = True Application.ScreenUpdating = True End Sub وهذا كود الطباعه Sub طباعة_الكشوف() 'الكود للمحترم احمد كامل 'الهدف من الكود هو طباعه اللجان المدرسيه 'تم هذا الكود في اكتوبر 2017 '**************** Range("F1").Select ActiveCell.FormulaR1C1 = "1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 2 Legan_Test ActiveWindow.SelectedSheets.PrintOut Loop While ActiveCell.Value <= Range("E1").Value Range("b1").Select End Sub جزى الله كل من كانت له بصمه في هذا العمل بكل خير

كود المحترم احمد كامل الخاص بطباعه اللجان جزاه الله كل خير وبارك فيه .. يارب Sub طباعة_الكشوف() Range("F1").Select ActiveCell.FormulaR1C1 = "1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 2 Legan_Test ActiveWindow.SelectedSheets.PrintOut Loop While ActiveCell.Value <= Range("E1").Value Range("b1").Select End Sub

جزاك الله كل خير وبارك فيك يارب .. استاذ احمد تمام Sub طباعة_الكشوف() Range("F1").Select ActiveCell.FormulaR1C1 = "1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 2 Legan_Test ActiveWindow.SelectedSheets.PrintOut Loop While ActiveCell.Value <= Range("E1").Value Range("b1").Select End Sub ======= عندما ارسل اليك رساله على الخاص تاتيني رساله بانك لاتستطيع استلام الرساله ... لماذا ؟

************************* طباعة شهادات الناجحين والراسبين ج3 طباعة 4 شهادات بورقة طباعة 3 شهادات print excel vba ساجدة العزاوي طلاب طلبة مدارس مدرسة شهادات الطلاب استخراج شهادات الطلبة طباعة شهادات الطلاب طباعة تقدير الطلاب نتائج نتيجة قناة ساجدة العزاوي التعليمية sajida alazzawi رابط ملف التطبيق 4 شهادات http://www.mediafire.com/file/yr1rrb7... رابط ملف 3 شهادات http://www.mediafire.com/file/p2k2u8x... رابط صفحة الفيس بوك https://www.facebook.com/sajidaalazza...

************************* طباعة شهادات الناجحين والراسبين ج3 طباعة 4 شهادات بورقة طباعة 3 شهادات print excel vba ساجدة العزاوي طلاب طلبة مدارس مدرسة شهادات الطلاب استخراج شهادات الطلبة طباعة شهادات الطلاب طباعة تقدير الطلاب نتائج نتيجة قناة ساجدة العزاوي التعليمية sajida alazzawi رابط ملف التطبيق 4 شهادات http://www.mediafire.com/file/yr1rrb7... رابط ملف 3 شهادات http://www.mediafire.com/file/p2k2u8x... رابط صفحة الفيس بوك https://www.facebook.com/sajidaalazza...