رجب جاويش

بعد اذن أخى الحبيب / أبو حنين ولاثراء الموضوع هذه محاولة أخرى آخر تاريخ تسديد1.rar

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

أخى الفاضل يمكنك الاطلاع على المشاركتين الأخيرتين على الرابط التالى سوف تجد فيهم ما تطلبه تماما http://www.officena.net/ib/index.php?showtopic=44325

تفضل أخى ابراهيم منع تكرار رقم1.rar

أخى الحبيب ابراهيم وعليكم السلام ورحمة الله وبركاته شكرا لك أخى الحبيب على سؤالك عنى وعن أحوالى بارك الله فيك وجزاك الله عنى خير الجزاء وعلى فكرة أخى الحبيب ما يجعلنى مشغول قليلا هذه الأيام عن منتداى الحبيب هو اندماجى فى عمل شيت كنترول للثانوى العام للصفين الأول والثانى لأنى انتقلت للعمل بالمرحلة الثانوية وهو يستغرق منى وقت كثير جدا أما بالنسبة للملف المرفق فحسب فهمى للمطلوب عملت هذا الكود فأرجو منك تجربته وان لم يكن كما تريد أبلغنى وان شاء الله أقوم بتعديلة كما تريد وهو كود فى حدث الورقة الثانية Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Integer, cl As Range LR = [A1000].End(xlUp).Row '========================================================== If Target.Column <> 1 Then Exit Sub For Each cl In Range("A6:A" & LR) If Application.WorksheetFunction.CountIf(Range(Cells(cl.Row, 1), Cells(LR, 1)), cl) > 1 Then MsgBox "هذا الرقم مكرر": Target = "": Target.Select: Exit Sub End If Next End Sub منع تكرار رقم.rar

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

أخى الفاضل جرب هذا الكود بدلا من الدالة Sub ragab() Dim sh As Worksheet Dim cl As Range, cll As Range Range("C2:C" &amp; [c10000].End(xlUp).Row).ClearContents For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Sheet6" Then For Each cl In Range("B2:B" &amp; [B10000].End(xlUp).Row) For Each cll In sh.Range("D2:D" &amp; sh.[D10000].End(xlUp).Row) If cll.Offset(0, -2) = cl Then cl.Offset(0, 1) = cl.Offset(0, 1) + cll End If Next Next End If Next End Sub فواتير1.rar

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

بعد اذن أخى الحبيب الشهابي ولاثراء الموضوع هذا حل آخر باستخدام المعادلة sumproduct test1.rar

أخى الفاضل جرب هذا الكود Sub ragab() On Error Resume Next x = InputBox("أدخل المدى الذى تريد تظليلة") With Range(x) .Select End With End Sub تظليل مدى.rar

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

اخى الفاضل جرب هذا الكود Sub ragab() For i = 5 To [B1000].End(xlUp).Row For ii = 5 To 17 Step 3 If Cells(i, ii) < 50 Then x = x + 1: y = y + (50 - Cells(i, ii).Value) Next Cells(i, "T") = x: Cells(i, "U") = y x = 0: y = 0 Next End Sub النتيجة.rar

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

بعد اذن أخى الحبيب / أبو أنس حاجب سبب الخطأ فى السطر Sheets(1).Select الموجود فى الكود التالى Sub auto_open() Application.WindowState = xlMaximized ' Application.DisplayFullScreen = True ' Application.CommandBars("Full Screen").Visible = False ' Application.CommandBars.ActiveMenuBar.Enabled = False Sheets(1).Select End Sub هو الذى يجعل الملف يذهب الى الصفحة bb2010 وبالتالى يجب حذف هذا السطر

أخى الفاضل / زوهير سوف تجد الكثير من المعلومات القيمة فى دورة شرح الفيجول بيسك للتطبيقات VBA الموجودة فى المنتدى على هذا الرابط http://www.officena.net/ib/index.php?showtopic=39323&st=0

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

أخى الفاضل جرب المرفق نظام صيرفة.rar

أخى الحبيب / محمود تقبل أرق وأجمل تحياتى على هذا المجهود الرائع

أخى الفاضل أنا لم أتابع الموضوع من البداية ولكن أرجو أن يكون المرفق كما تريد محل صيرفة استاذ صادق.rar

البقاء لله انا لله وانا اليه راجعون

بعد اذن أخى الفاضل / عبد الله المجرب ولاثراء الموضوع هذه المعادلة لجمع الأرقام داخل الصفوف الفردية =SUM(IF(MOD(ROW(A1:A10);2)=1;A1:A10)) وهذه لجمع الأرقام داخل الصفوف الزوجية =SUM(IF(MOD(ROW(A1:A10);2)=0;A1:A10)) مع الضغط على Ctrl+Shift + Enter معاً ------.rar

وهذا هو الحل بالمعادلات الرواتب2.rar

أخى الفاضل أنا تحت أمرك فى أى تعديل جرب هذا الكود واخبرنى بالنتيجة Sub ragab() Dim LR As Integer, sh As Worksheet Dim cl As Range, cll As Range Application.ScreenUpdating = False LR = Cells(Rows.Count, 4).End(xlUp).Row '============================================================== For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "الغياب" Then sh.Range("S5:T100").ClearContents For Each cl In sh.Range("A5:A" & [A5].End(xlDown).Row) For Each cll In Range("D2:D" & LR) If cll = cl And cll <> "" Then cl.Offset(0, 18) = cll.Offset(0, 1) cl.Offset(0, 19) = cll.Offset(0, 2) End If Next Next End If Next Application.ScreenUpdating = False End Sub الرواتب1.rar

وهذا حل آخر بالمعادلات مع تعديل بسيط فى معادلات العمود M الرواتب1.rar

أخى الفاضل جرب هذا الكود Sub ragab() Dim cl As Range, cll As Range, cel As Range LR = [B1000].End(xlUp).Row Application.ScreenUpdating = False Set rng1 = Sheets("warehouse").Range("A5:A48") Set rng2 = Sheets("Main Branch").Range("A5:A19") For Each cl In Range("B2:B" & LR) For Each cll In rng1 If cl = cll Then cll.Offset(0, 8) = cl.Offset(0, 1) End If Next Next For Each cl In Range("B2:B" & LR) For Each cel In rng2 If cl = cel Then cel.Offset(0, 8) = cl.Offset(0, 1) End If Next Next Set rng1 = Nothing Set rng1 = Nothing Application.ScreenUpdating = True End Sub الرواتب.rar