رجب جاويش

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

أخى الفاضل / سعد عابد جزاك الله كل خير وباذن الله وتوفيقه يتم اكمال السلسلة

أخى الفاضل / محمد يوسف أولا يجب استخدام العمود رقمم 77 وليس 76 فى اختبار شرط الترحيل ( ناجح أو له دور ثانى فى ) للأن العمود 76 يحتوى على جملة طويلة فى حالة الدور الثانى ( له دور ثانى فى مادة كذا وكذا ) ثانيا تم ازلة بعض المسافات الزائدة بجوار كلمة ناجح ودور ثانى فى عمود 77 لانها تمنع عمل الكود ( يجب أن تتطابق مع الكلمات داخل الكود ) وأيضا تم ازالة مسافة زائدة بجوار اسم صفحة ناجح المرحل اليها الناجحون واليك المرفق بعد التعديلات ترحيل ثانية أدبى.rar

الحل الثالث دالة معرفة تستخدم لايجاد عدد مرات تكرار اسم اسم تريدة ( يكتب فى معطيات الدالة ) Function ragab(rng As Range, nam As String) As Integer For Each cl In rng arr = Split(Trim(cl)) For i = 0 To UBound(arr) If arr(i) = nam Then T = T + 1 End If Next Next ragab = T End Function وتستخدم كالآتى =ragab(A1:A100;"احمد") حيث يمكنك كتابة أى اسم آخر تريدة غير الاسم احمد داخل الدالة New Microsoft Excel Worksheet2.rar

الحل الثانى دالة معرفة تستخدم لايجاد عدد مرات تكرار اسم احمد فقط حتى لو تكرر الاسم أكثر من مرة فى الخلية الواحدة Function ragab(rng As Range) As Integer For Each cl In rng arr = Split(Trim(cl)) For i = 0 To UBound(arr) If arr(i) = "احمد" Then T = T + 1 End If Next Next ragab = T End Function وتستخدم كالآتى =ragab(A1:A100) New Microsoft Excel Worksheet1.rar

تفضل أخى الحل الأول هذه الدالة =COUNTIF(A:A;"*احمد*") وهى بشكل سليم فقط اذا كان الاسم احمد يوجد مرة واحدة فقط فى كل خليه ولا يتكرر فى الخلية الواحدة New Microsoft Excel Worksheet.rar

أخى الفاضل / إبراهيم ابو ليله يمكنك أخى الفاضل الدخول على الـ Channel الخاص بى على اليوتيوب وتحميل الفيديوهات على جهازك ثم تشاهدها فى أى وقت تريد والرابط هو http://www.youtube.com/user/MrRagab100100?feature=watch

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

أخى الفاضل / محمد يوسف شكرا جزسلا أخى الفاضل وجزاك الله كل خير

أخى الفاضل محمد تم اضافة زر داخل الفورم لحذف الأرقام القومية المكررة المخبز الخيري رجب جاويش1.rar

إخوتى الاعزاء أسمحو لى ان أشارك معكم فى هذا المشروع الجميل بهذا الفورم وهو فورم متخرج من مدرسة خبورية ( نسبة الى أستاذى خبور خير " عبد الله باقشير " ) المخبز الخيري رجب جاويش.rar

بسم الله الرحمن الرحيم إخوانى الأعزاء السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم الدرس الخامس من ( سلسلة الفارس فى شرح دوال الإكسل عن طريق الفيديو ) وهو بعنوان شرح الدالة SUMIF http://youtu.be/9zWpw0I3F7A SUMIF دالة.rar

أخى الفاضل / مستر وليد جزاك الله كل خير

الأخت الفاضلة / سما محمد حالا يتم نزول الدرس الجديد

السلام عليكم كورس رائع وجميل فعلا جزاك الله كل خير

أخى الفاضل لاحظ بعض التعديلات فى الكود Sub Tarheel() Dim i As Integer, x As Integer Dim lr As Integer, y As Integer lr = [b10000].End(xlUp).Row Sheets("ناجح").Range("a14:ce1000").ClearContents Sheets("دور ثان").Range("a14:ce1000").ClearContents Application.ScreenUpdating = False x = 14: y = 14 For i = 14 To lr If Cells(i, 83).Value = "ناجح" And Cells(i, 3) <> " " Then Range("a" & i).Resize(1, 83).Copy Sheets("ناجح").Range("a" & x).PasteSpecial xlPasteValues Application.CutCopyMode = False x = x + 1 ElseIf Cells(i, 83).Value = "له دور ثانى فى" And Cells(i, 3) <> " " Then Range("a" & i).Resize(1, 83).Copy Sheets("دور ثان").Range("a" & y).PasteSpecial xlPasteValues Application.CutCopyMode = False y = y + 2 End If Next i MsgBox "تم بحمد الله فصل ناجح وله دور ثان", vbOKOnly, "ترحيل الناجحين والراسبين" Application.ScreenUpdating = True End Sub

أخى الفاضل سيكون الكود كالآتى Sub ragab() Dim arr() As Double Application.ScreenUpdating = False On Error Resume Next x = ActiveWorkbook.Name WB = ActiveWorkbook.Path & "\" & "كنترول نصف العام" & ".xls" Workbooks.Open Filename:=WB LR = ActiveWorkbook.Sheets("رصد اول").Cells(Rows.Count, 3).End(xlUp).Row ReDim arr(1 To LR - 12, 1 To 4) For i = 13 To LR ii = ii + 1 arr(ii, 1) = Cells(i, "H") arr(ii, 2) = Cells(i, "M") arr(ii, 3) = Cells(i, "R") arr(ii, 4) = Cells(i, "W") Next ActiveWindow.Close T = 1 For R = 13 To LR Workbooks(x).Sheets("رصد اول").Cells(R, "D") = arr(T, 1) Workbooks(x).Sheets("رصد اول").Cells(R, "J") = arr(T, 2) Workbooks(x).Sheets("رصد اول").Cells(R, "P") = arr(T, 3) Workbooks(x).Sheets("رصد اول").Cells(R, "V") = arr(T, 4) T = T + 1 Next Application.ScreenUpdating = True End Sub

تفضل أخى الفاضل هذا كود يقوم بعمل المطلوب Sub ragab() Dim arr() As Double Application.ScreenUpdating = False On Error Resume Next x = ActiveWorkbook.Name WB = ActiveWorkbook.Path & "\" & "كنترول نصف العام" & ".xls" Workbooks.Open Filename:=WB LR = ActiveWorkbook.Sheets("ورقة1").Cells(Rows.Count, 3).End(xlUp).Row ReDim arr(1 To LR - 12, 1 To 2) For i = 13 To LR ii = ii + 1 arr(ii, 1) = Cells(i, "H") arr(ii, 2) = Cells(i, "M") Next ActiveWindow.Close T = 1 For R = 13 To LR Workbooks(x).Sheets("ورقة1").Cells(R, "D") = arr(T, 1) Workbooks(x).Sheets("ورقة1").Cells(R, "J") = arr(T, 2) T = T + 1 Next Application.ScreenUpdating = True End Sub كنترول.rar

أخى الفاضل /مستر وليد جزاك الله كل خير

أخى الفاضل جزاك الله كل خير

أخى الفاضل /jo11 جزاك الله كل خير

أخى الفاضل / أبو ردينة شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة وجزاك الله كل خير

أخى الفاضل / مصطفى كامل شكرا جزيلا أخى الفاضل على هذه اللفتة الكريمة الطيبة التى تدل على أصلك الطيب وشخصك الكريم وجزاك الله كل خير

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

أخى الفاضل فى الكود فى الجزء الخاص بالراسبين غير الجزء y = y + 1 الى الجزء y = y + 2