بن علية حاجي

السلام عليكم ورحمة الله أخي الكريم مصطفى، هذه محاولة مع الملف المرفق إن كنت قد فهمت المطلوب... أخوك بن علية If Amendment.rar

السلام عليكم ورحمة الله أخي الكريم، إضافة 7% لأي عدد هو ضرب هذا العدد بـ (1 + 7%) أي الضرب بالعدد 1,07 وإضافة 7% إلى العدد 20.14 يعطي العدد 21,5498 أي بالتقريب 21.55 ... والله أعلم أخوكم بن علية

السلام عليكم ورحمة الله أخي الكريم، بالفكرة نفسها يمكن تخصيص الرقم في الخلية باستعمال التنسيق Standard ثم مخصص Personalise ونختار التنسيق بإضافة الرمز "0" إلى يسار كلمة General في إطار Type فيكون كما يلي: "0"General والله أعلم أخوكم بن علية

السلام عليكم ورحمة الله أختي الكريمة، هذا حل أول بمعادلة صفيف أرجو أن تفي بالمطلوب... أخوك بن علية dd.zip

السلام عليكم ورحمة الله أخي الكريم، هذا حل آخر بالفكرة نفسها (والاستعانة بالخليتين A1 و A2) والكود يعمل لسنة كاملة (أو أكثر إذا أدرجت مع التاريخ Combobox خاص بالسنة)... أخوكم بن علية date1.rar

السلام عليكم ورحمة الله أخي الكريم، إليك المطلوب في الملف المرفق بإضافة زر المقارنة للتحذير "مقارنة عدد المتقدمين والموزعين"... أخوك بن علية كود تحذير 4.rar

السلام عليكم ورحمة الله أخي الكريم مصطفى أولا أنت لم تحرجني ولم تتعبني البتة... وتجدني إن شاء الله في الخدمة متى شئت... وثانيا بالنسبة للتنسيقين الشرطيين الجديدين يجب الترتيب بينهما (التنسيقات الأخرى غير مؤثرة فيها): الأول (هو الشرط لما تكون خانة التاريخ فارغة ويجب اختيار الخط الأبيض من الأسفل ولا نترك الشرط دون تنسيق) والثاني (هو شرط تلوين الخط الأسفل باللون الأسود لنهاية كل الشهر) (ويؤثر تبديل هذا الترتيب)... المهم قد قمت بتصحيح هذا الخلل في الملف المرفق... أخوك بن علية --Trading Investments-- 11.rar

السلام عليكم ورحمة الله أخي الكريم محمود، في الحقيقة الكود كان موجودا من قبل ولم أغير سوى E11 بـ D11... والكود صحيح كما وضعته في ردي السابق لأن الخلية D11 تحوي عدد الطلاب المتقدمين بينما E3 تحوي عدد الطلاب الموزعين على اللجان وفي ملفك المرفق عدد المتقدمين 100 (من الخلية D11) وهو أقل من عدد الموزعين 110 (من الخلية E3) و( msg box ) في ملفك تجد العكس... أخوك بن علية

السلام عليكم ورحمة الله أخي الكريم إن الخلل في كود "الخطأ" للورقة "الاسماء" والخلل في مقارنة الخليتين E11 و E3 والصحيح أن تقارن بين الخليتين D11 و E3 والكود يصبح كما يلي: Private Sub Worksheet_Change(ByVal Target As Range) If Range("E3").Value < Range("D11").Value Then MsgBox "عدد الطلاب المتقدمين أكبر من عدد الطلاب في جميع اللجان", vbInformation, "خطأ " Range("D11").Select Else If Range("E3").Value > Range("D11").Value Then MsgBox " عدد الطلاب المتقدمين أقل من عدد الطلاب في جميع اللجان ", vbInformation, "خطأ" Range("E3").Select End If End If End Sub أخوك بن علية وإليك الملف مصحح مع تعديل لبعض المعادلات : كود تحذير 3.rar

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

السلام عليكم ورحمة الله أخي الكريم إبراهيم، الإضافة التي وضعتها في الكود والتي تتمثل في الأسطر التالية Range(Cells(Target.Row + 1, 4), Cells(Target.Row + 1, 7)).Select Selection.Merge Cells(Target.Row + 1, 1).Select لا تحتاج إلى شرح ولكن أحاول تقريب مفهومها لتتضح الصورة... أولا هذه الإضافات وُضعت مباشرة بعد إدراج السطر في نهاية الجداول... * السطر الأول يقوم بتحديد الخلايا في السطر المضاف من العمود رقم 4 (أي العمود D) إلى العمود رقم 7 (أي العمود G) * السطر الثاني يقوم بدمج Merge للخلايا المحددة من هذا السطر * السطر الثالث يعيد المؤشر (التحديد) إلى الخلية الأولى (من العمود A) من السطر المضاف أرجو أني وُفقت في الشرح... أخوك بن علية

السلام عليكم ورحمة الله أخي الكريم مصطفى، بتعديل طفيف على التنسيق الشرطي الخاص بالإطار Border تم المطلوب... أرجو أني وُفّقت في التعديل... أخوك بن علية --Trading Investments-- 9.rar

السلام عليكم ورحمة الله أخي الكريم إبراهيم، تم تعديل طفيف على الكود بإضافة الأسطر التالية (في عدة مواضع) : Range(Cells(Target.Row + 1, 4), Cells(Target.Row + 1, 7)).Select Selection.Merge Cells(Target.Row + 1, 1).Select الكل تجده في الملف المرفق (ملف إكسيل 2003)... أخوك بن علية SHER.rar

السلام عليكم ورحمة الله عيدكم سعيد وكل عام وأنتم بخير.... أخواني الكرام، أخي الكريم محمود إن العبارة (ISNONTEXT(A1:H1 في المعادلة =ISNONTEXT(A1:H1)*(SUM(A1:H1)) ليس لها أي تأثير على نتيجة المعادلة ويمكن حذفها والاكتفاء فقط بالجزء (SUM(A1:H1... المهم أن لا نستعمل الرمز "+" لجمع خلايا (متجاورة أو غير متجاورة) في حالة احتواء بعض من هذه الخلايا على نصوص... والله أعلم أخوكم بن علية

السلام عليكم ورحمة الله عيدكم سعيد وكل عام وأنتم بألف خير... أخي الكريم، أعتقد أنه في هذه الحالة يكفي استعمال الدالة SUM فقط مثل: =SUM(A1;D1;H1;M1;P1;Q1;U1;AA1;AF1;AZ1) أخوكم بن علية

السلام عليكم ورحمة الله عيدكم مبارك وسعيد، كل عام وأنتم بألف خير أعاده الله علينا بالخير واليمن والبركات... أخي الكريم، وأستسمح أخي العزيز محمود في تقديم الملف المرفق التالي حيث حاولت فيه المطلوب الجديد باستعمال خاصية التنسيقات الشرطية حسب عمود التاريخ إضافة إلى التنسيقات السابقة.... أتمنى أن يكون الملف المرفق ملبيا للمطلوب.... أخوكم بن علية --Trading Investments--.rar

السلام عليكم ورحمة الله إنا لله وإنا إليه راجعون أخي الكريم سعيد، أعظم الله أجركم وغفر لميتكم... اللهم تغمدها برحمتك واعتق رقبتها من النار في هذا الشهر الكريم ووسّع لها قبرها واجعله روضة من رياض الجنة ومدّ لها في قبرها مدّ بصرها وألهم ذويها وأهلها الصبر والسلوان... وأجر الصابرين عظيم... أخوك بن علية

السلام عليكم ورحمة الله أخي الكريم، بعض التعديلات تمت على ترتيب أوراق المستند (لأجل الإحصائيات) ثم تعديلات أخرى على الكود (إضافة + ترتيب بين كود الإحصائيات والترقيم التسلسلي)... الكل في الملف المرفق... أخوك بن علية يوسف ترحيل.rar

السلام عليكم ورحمة الله أخي الكريم، أعتقد أن الخلل في السطر For k = 1 To 6 من المفروض أن يكون : For k = 1 To 7 وهذا حسب ما لاحظت في كود عمل أرقام التسلسل في شيتات الترحيل... والسطران : rrw = Sheets(J).[A3000].End(xlUp).Row و y = Sheets(k).[A3000].End(xlUp).Row - 4 ألا ينبغي أن يكونا : rrw = Sheets(J).[B3000].End(xlUp).Row و y = Sheets(k).[B3000].End(xlUp).Row - 4 لست أدري إن كانت هذه الملاحظات تصحح الخلل لأنه دون ملف تجريبي لا يمكن معرفة موطن الخلل وحسن عمل الأكواد.... أخوك بن علية

السلام عليكم ورحمة الله أخي الحبيب عبد الله، بورك لك في الموهوب، وشكرت الواهب، وبلغ أشده، ورزقت بره... أخوك بن علية

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

السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير في هذا اليوم المبارك وفي هذا الشهر المبارك وفي غيرهما... أخي الكريم مصطفى، إليك بالملف المرفق مع المطلوب... أخوك بن علية --Trading Investments--.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم صالح الأعمال بمزيد من الأجر والثواب... أخي الكريم هذه محاولة في الكود ولكن جعلت الترقيم التلقائي للتسلسل في العمود A انطلاقا من الخلية A5 ويمكنك التغيير فيه..... Sub ترحيل_فصول() ''' متغيرات بعدد الصفحات المطلوب الترحيل اليها Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه Sheets("1").Range("A5:DZ5000").ClearContents Sheets("2").Range("A5:DZ5000").ClearContents Sheets("3").Range("A5:DZ5000").ClearContents Sheets("4").Range("A5:DZ5000").ClearContents Sheets("5").Range("A5:DZ5000").ClearContents Sheets("6").Range("A5:DZ5000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات A = 5: B = 5: C = 5: D = 5: E = 5: F = 5 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 5 To 5000 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 4) = "1" Then ''' عدد الأعمدة التى سيتم ترحيلها Range("A" & R).Resize(1, 9).Copy ''' سيتم اللصق في هذا الشيت Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If If Cells(R, 4) = "2" Then Range("A" & R).Resize(1, 9).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If If Cells(R, 4) = "3" Then Range("A" & R).Resize(1, 9).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If If Cells(R, 4) = "4" Then Range("A" & R).Resize(1, 9).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If If Cells(R, 4) = "5" Then Range("A" & R).Resize(1, 9).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If If Cells(R, 4) = "6" Then Range("A" & R).Resize(1, 9).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If Next MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") For k = 1 To 6 y = Sheets(k).[A3000].End(xlUp).Row - 4 mssg = mssg & Chr(10) & Format(y, "00") & " Students to Sheet : " & k Next k MsgBox (" تم ترحيل عدد" & mssg) Range("a1").Select For J = 1 To 6 Sheets(J).[A5] = 1 rrw = Sheets(J).[A3000].End(xlUp).Row For Each cc In Sheets(J).Range("A6:A" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next J Application.ScreenUpdating = True End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' أرجو أني وفقت في تعديل الكود.... أخوك بن علية

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال وجمعة مباركة لكل المسلمين.... أخي الكريم يوسف، لتصحيح الكود وعمله يكفي إضافة العبارة End If لكل If في الكود فيكون الكود في الأخير كما يلي: Sub ترحيل_فصول() ''' متغيرات بعدد الصفحات المطلوب الترحيل اليها Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه Sheets("1").Range("A5:DZ5000").ClearContents Sheets("2").Range("A5:DZ5000").ClearContents Sheets("3").Range("A5:DZ5000").ClearContents Sheets("4").Range("A5:DZ5000").ClearContents Sheets("5").Range("A5:DZ5000").ClearContents Sheets("6").Range("A5:DZ5000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات A = 4: B = 4: C = 4: D = 4: E = 4: F = 4 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 5 To 5000 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 4) = "1" Then ''' عدد الأعمدة التى سيتم ترحيلها Range("A" & R).Resize(1, 9).Copy ''' سيتم اللصق في هذا الشيت Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "2" Then Range("A" & R).Resize(1, 9).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "3" Then Range("A" & R).Resize(1, 9).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "4" Then Range("A" & R).Resize(1, 9).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "5" Then Range("A" & R).Resize(1, 9).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "6" Then Range("A" & R).Resize(1, 9).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' Next MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") Application.ScreenUpdating = True End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' والله أعلم أخوك بن علية

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