ياسر خليل أبو البراء

أخي الكريم خالد إذا كان الأمر قد تم فيرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

أخي الكريم أبو عبد الملك (كبر حجم الخط لوضوح الرؤية) أعتقد اننا اتفقنا فيما سبق أن يكون رأس العمود (العنوان) باللون الأزرق في حالة أنه يتم فيه الإدخال بشكل يدوي (ألا تتذكر الأمر) عموماً معادلة الجمع سليمة وتجمع من 7 أعمدة لا اختلاف في الأمر .. المشكلة أنني أضفت سطر يمسح البيانات أولاً ومن ضمن الأعمدة التي يتم مسحها الأعمدة التي أشرت إليها إليك الملف مع تعديل حرف واحد فقط في الكود ليعمل بشكل صحيح فقد غيرت ليكون السطر بهذا الشكل .Range("A2:G1000,K2:M1000,P2:Q1000,S2:W1000").ClearContents استبدلت حرف الـ I إلى حرف G ليتم تجنب العمودين H و I Quran School V10.rar

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله مع التحديث الجديد .. للأسف لم أجد التوجيهات التي تم وضعها من قبل ، وهذه القواعد والأسس هامة جداً ليدرك الأعضاء كيفية التعامل مع المنتدى طبعاً الموضوع سيكون متجدد .. سيتم وضع القواعد مرة أخرى فالرجاء الرجاء أن تساعدوني في اتمام الأمر .. كل عضو يذكرني بتوجيه من هذه التوجيهات ليتم إرساء القواعد ، إذ أن نجاح أي مؤسسة يعتمد في المقام الأول على قواعد ومنهج ثابت للسير على دربه التوجيهات والقواعد التي يجب مراعاتها التوجيه الأول : قبل طرح موضوع جديد يتعلق بطلب محدد يرجى استخدام خاصية البحث أولاً ، فإذا لم يجد طارح الموضوع بغيته ، فعليه أن يقوم بطرح موضوع جديد ، وفي هذه الحالة على طارح الموضوع أن يعلم أن حسن السؤال شطر الإجابة ، فاللباقة واللياقة والكياسة من الصفات التي يجب أن يتحلى بها طالب العلم. التوجيه الثاني : عند طرح موضوع جديد ، يتم وضع عنوان مناسب للطلب بحيث يفهم الطلب قبل الإطلاع عليه ، وعلى طارح الموضوع أن يبتعد عن العناوين الغير مجدية مثل : ( طلب مساعدة - الرجاء المساعدة - ساعدوني من فضلكم - عاجل وهام - الحقوني - نداء للعباقرة - نداء للعمالقة - إلى آخر تلك العناوين ...) ، وأمر آخر ألا يكون العنوان على شكل سؤال أو طلب .. نبتعد عن كلمة "طلب" مثال تطبيقي : نفترض أنني أريد معادلة تجمع القيم في عمودين العنوان المناسب للطلب يكون بهذا الشكل : معادلة جمع القيم في عمودين والنتائج في عمود آخر التوجيه الثالث : أن يتم توضيح المطلوب بالموضوع بشكل يزال معه أي لبس ، وفي نفس الوقت يراعى الإجمال في الطلب ، فأقصر الخطوط هو الخط المستقيم ، بمعنى "لا إطالة مملة ولا اختصار مخل" ، أي لا يكون طرح الموضوع مختصر للغاية بل يجب أن يستوفي جميع العناصر المطلوبة ، ومن ضمنها أن يحدد طارح الموضوع هل الحل المطلوب بالمعادلات أم بالأكواد أم بكلاهما لتكون الأمور واضحة بالنسبة لمن يريد تقديم المساعدة ، وأن يقوم صاحب الموضوع بإرفاق ملف به بيانات وهمية لتوضيح طلبه وللوصول إلى حل سريع ودقيق ، وإذا صعب على طارح الموضوع شرح المطلوب يمكنه إرفاق بعض النتائج المتوقعة كي يسهل الوصول لحل. التوجيه الرابع : نلاحظ أن شكل المنتدى لا يعجب معظم الأعضاء ، فلما لا نغير بأيدينا الشكل العام للمشاركات ، فيفضل على سبيل المثال استخدام حجم خط كبير 22 على سبيل المثال وجعل الخط عريض Bold مما يجعل المشاركة واضحة ومقروءة بشكل جيد ، كما يمكن استخدام الألوان أي قم بتنسيق المشاركة بشكل جذاب يجعل القاريء لا ينفر منها. التوجيه الخامس : بعد الانتهاء من الموضوع والوصول لحل يرضي صاحب الموضوع ، يرجى أن يتم تحديد أفضل إجابة من خلال النقر على علامة الصح الموجودة بجانب كل مشاركة ، وأن يسجل صاحب الموضوع إعجابه من خلال النقر على "سجل اعجاب بهذا" كنوع من رد الجميل لمن قدم المساعدة ، ويمكن أيضاً أن يقوم بتقييم المشاركة تقييم إيجابي كنوع من التقدير ، وأن تشكر من قدم المساعدة فمن لم يشكر الناس لا يشكر الله. فيما يخص لو كان هناك أكثر من إجابة للموضوع ، يمكن لصاحب الموضوع عمل مشاركة جديدة يجمع فيها كل الحلول ويختار هذه المشاركة كأفضل إجابة التوجيه السادس : لا تكن لحوحاً ، يكفي أن أعضاء المنتدى يقدمون وقتهم و خبرتهم مقابل لا شيء وعندهم أعمال أخرى (مشاغلهم الخاصة) يقومون بها ، و إذا تأخر الرد ، فمن الممكن أن يكون أحد الأعضاء يقوم بمحاولة الإجابة ، وهذا يستغرق بعض الوقت خاصةً إذا كان الموضوع صعباً. التوجيه السابع : حمل الملف المرفق دون زركشات (ألوان و تنسيقات مختلفة) مما يزيد من حجم الملف و أحياناً تكون الألوان مقززة بشكل ينفر منها المساعد (خاصةً إذا كانت ألوان الخلايا غير متناسقة مع لون الخط) التوجيه الثامن : تأكد أن الملف المرفوع غير مصاب بفيروس و غير محمي بكلمة سر ، وإلا لن تجد المساعدة من قبل الأعضاء. التوجيه التاسع : متابعة صاحب الموضوع لموضوعه والتفاعل معه ، فلا يعقل أن يطرح أحدهم موضوع ولا يتابعه إلا بعد مرور وقت طويل ، فهذا يعد من اللامبالاة الغير مرغوب فيها ، والتي تنفر الجميع من العضو. التوجيه العاشر : عدم التسجيل في المنتدى بأكثر من حساب ، وأن يكون اسم الظهور باللغة العربية ومعبر عن الاسم الحقيقي أي (تعريب اسم العضو) ، فلا يجوز أن يكون اسم الظهور اسم واحد وفقط بل أن يكون ثنائي على الأقل أو أن يكون اسم ولقب ، ولذا يرجى عدم استخدام الأسماء المستعارة أو الأسماء باللغة الأجنبية ، فاللغة العربية هي هويتنا ولابد من الحافظ عليها. ** يتم تغيير اسم الظهور أو اسم المستخدم من خلال إعدادات الحساب ثم التبويب اسم المستخدم ، قم بتغيير الاسم ثم انقر كلمة حفظ التوجيه الحادي عشر : عدم طرح أكثر من موضوع لنفس الطلب من نفس العضو ، فهذا يعد مخالفة صريحة ، وليعلم العضو الذي يقوم بذلك أن تكرار الموضوع لن يجدي نفعاً في حالة عدم توضيحه للمطلوب. وفي حالة أن قام العضو بذلك عن طريق الخطأ يقوم العضو بالتنويه في الموضوع وطلب حذف الموضوع نظراً لتكراره. التوجيه الثاني عشر : على من يقدم المساعدة أن يكون مثالاً يحتذى به في العطاء والصبر والحلم وكرم الأخلاق وحسن الإجابة ، يجتذب بتلك الصفات عقول الآخرين وأفئدتهم التوجيه الثالث عشر : عند طرح موضوع يفضل أن يكون هناك طلب واحد فقط إذ أن الموضوع الذي تكثر فيه الطلبات ينفر الأعضاء الذين يريدون تقديم يد المساعدة ، وعلى رأي المثل (من يطارد عصفورين يفقدهما) فما بالك لو طاردت أكثر من طلبين أقصد أكثر من عصفورين ، يمكنك أن تتعامل بذكاء بأن تطرح الموضوع بطلب واحد حتى إذا تم على خير قم على الفور بطرح موضع جديد بطلب جديد وهكذا إلى أن يتم الأمر التوجيه الرابع عشر : يرجلا عدم إرسال رسائل خاصة للأعضاء لطلب المساعدة بشكل شخصي ، لأن هذا الأمر يضايق الكثير من الأعضاء ، وتأكد أن العضو إذا كان لديه معلومة أو يستطيع أن يفيد بشيء ووقته يسمح بذلك فلن يتأخر عنك ، يكفي أن تكتب كلمة "للرفع" في موضوعك ، ليشاهده أكبر عدد من الأعضاء. ** كيفية رفع الصور في المشاركات : ******************************* دمتم على طاعة الله

أخي الكريم أبو عبد الملك كما تعودنا منك يفضل دائماً أن ترفق بعض النتائج المتوقعة لاختبار مدى صحة الكود .. عموماً إليك الملف المرفق تم إضافة السطر التالي للكود ليقوم بالمطلوب إن شاء الله .Cells(I, "T").Value = Application.WorksheetFunction.Sum(.Range("E" & I & ":" & "I" & I), .Cells(I, "K"), .Cells(I, "M")) / 2 رجاء للأخوة الأعضاء أن يقوموا بتكبير حجم الخط إلى 22 أو 24 بحيث يكون واضح ومقروء Quran School V10.rar

أخي وحبيبي في الله أبو يوسف بارك الله فيك على النصيحة .. صراحة أنا لست في مزاجٍ جيد اليوم لظروف خاصة هذا من ناحية من ناحية أخرى الجو شديد الحرارة وأنا أتأثر نفسياً بدرجات الحرارة المرتفعة ويسبب لي ضغط كبير وحدة في الطباع من ناحية أخرى لم أتأقلم على الشكل الجديد للمنتدى مما يشعرني ببعض التوتر في التعامل مع المنتدى من ناحية أخرى الأخوة الأعضاء لا يلتزمون البتة بالتوجيهات مع علم معظمهم بها وهذا يضايقني بعض الشيء ومن ناحية أخرى اختفت التوجيهات .. لا أدري ما الذي يحدث ؟! وأعتقد من الصعب إرساء القواعد مرة أخرى أريد الالتزام بالتوجيهات لتيسير الأمور .. وفي الختام أرجو ألا يتضايق مني أي أحد وأرجو المسامحة

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

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

الموضوع غير مستوفي لشرح المطلوب ... يرجى عدم طرح موضوع بدون التوضيح التام في الموضوع وداخل المرفق ... تقبل تحياتي

جرب الكود التالي Sub DeleteAllSheets() Dim WS As Worksheet Application.DisplayAlerts = False For Each WS In ThisWorkbook.Sheets If WS.Name <> "Sheet1" And WS.Name <> "Sheet2" Then WS.Delete Next WS Application.DisplayAlerts = True End Sub

أخي الكريم خالد يمكنك إضافة شهور وسنوات كما ترغب فقط ضع السنوات في العمود الأول في ورقة النتائج ونفذ الكود .. لا يوجد معادلات يجب ترك صفين بين كل سنة وأخرى على الأقل جرب الملف التالي Transfer Based On Years YasserKhalil V2.rar

أخي الكريم خالد الشاعر جرب الكود التالي عله يفي بالغرض Sub Test() Dim lRow As Long, I As Long lRow = 4 Application.ScreenUpdating = False With Sheet1 For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Sheet2.Cells(lRow, 1) = .Cells(I, 1) Sheet2.Cells(lRow, 2) = .Cells(I, 2) & " " & .Cells(I, 3) lRow = lRow + 1 Next I End With Application.ScreenUpdating = True End Sub

أخي الكريم أبو عبد الملك إليك الملف التالي عله يفي بالغرض .. يرجى عدم التعديل في الأكواد إلا بمعرفتي (لمعرفة التعديلات وليس تشكيكاُ في قدراتك بالتأكيد) Quran School V10.rar

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

وعليكم السلام ورحمة الله وبركاته أبي الحبيب أبو يوسف مشكور على كلماتك الطيبة .. الأمر كما ذكرت لا يضرني في شيء والحمد لله وأعتقد أن من قام بذلك قام عن طريق الخطأ .. وصحح ما قام به ولكن ما زلت أطلب أن يظهر أسماء الأعضاء الذي قاموا بالإعجاب والذين قيموا تقييم سلبي وأمر آخر ألا يكون التقييم سواء إيجابي أو سلبي مجرد نقرة بالماوس بل يجب أن يدعم بتعليق على التقييم لمعرفة لماذا سلبي أو إيجابي تقبل تحياتي

غريبة دي ... رغم إن مشاركتي أول مشاركة ..إلا إنها جااااااااااات في آخر الموضوع ... أيوا أيوا يبدو إن فيه عضو محترم قيم المشاركة تقييم سلبي على أساس إن المشاركة ملهاش لازمة مجرد مشاركة عادية زي دي عموماً موضوع التقييم دا جديد (مش عايز أظلم حد ..يمكن عملها من غير ما ياخد باله) بس من حقي أعرف مين اللي قيمني سلبي .. زي ما هو من حقي أعرف من داس على الإعجاب .. أنا أعترض وبشدة أستاذ محمد طاهر

بارك الله فيك أخي الحبيب خالد الرشيدي على هذه المعادلة الرائعة والجميلة

أخي الكريم نور وحيد جرب المعادلة التالية في الخلية D2 =IFERROR(INDEX($J$3:$M$16,LARGE(INDEX(($I$3:$I$16=$B2)*ROW($I$3:$I$16),0),1)-ROW($I$3)+1,MATCH($F2,$J$2:$M$2,0)),"")

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

أخي الفاضل أهلا ومرحباً بك في المنتدى من المفترض أن يتم شرح المطلوب بشكل أكثر تفصيلاً ولكن لأني عملت على مثل هذا الكود من قبل فقد أدركت المطلوب .... يرجى الإطلاع على موضوع التوجيهات للأعضاء الجدد في الموضوعات المثبتة في المنتدى ويرجى تغيير اسم الظهور للغة العربية إليك الكود التالي عله يفي بالغرض Sub TransferDataToClosedWB() On Error Resume Next Dim WB As Workbook Dim LR_A As Long, LR_B As Long Dim Answer As Long LR_A = IIf(Cells(Rows.Count, 1).End(xlUp).Row <= 8, 9, Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False ThisWorkbook.Sheets("Sheet1").Range("B9:K" & LR_A).Copy Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "اكسل2.xlsm") With WB.Sheets("Sheet1") LR_B = IIf(Cells(Rows.Count, 1).End(xlUp).Row <= 2, 3, Cells(Rows.Count, 1).End(xlUp).Row + 1) .Range("A" & LR_B).PasteSpecial xlPasteValues .Range("L" & LR_B).Value = ThisWorkbook.Sheets("Sheet1").Range("F6").Value .Range("M" & LR_B).Value = ThisWorkbook.Sheets("Sheet1").Range("B4").Value End With On Error GoTo 0 WB.Close SaveChanges:=True Application.CutCopyMode = False Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة وأن تضغط على كلمة "سجل إعجاب بهذا" .. Desktop V2.rar

أخي الحبيب الغالي حسام مبارك النسخة الجديدة وربنا يجعله في ميزان حسناتك يوم القيامة ممكن الامتداد Avi ... أو ترفع الفيديو على اليوتيوب .... وسؤال هل الفيديو صامت أم أنه صوتك الجميل يشجي فيه ؟؟؟؟!! حيث أنني قمت تنصيب برنامج كامستيا عشان أقدر أشوف الفيديو ولكن لم أسمع لك صوتاً .. لا أسكت الله لك حساً تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته أخي وحبيبي في الله وأبي الحبيب أبو يوسف مشكور على كلماتك الرقيقة في حقي وجزاك الله كل خير على حسن متابعتك وأسلوبك الطيب المحفز تقبل وافر تقديري واحترامي قمت بضغط الملف ..يجوز الإمتدادات الجديدة فيها مشكلة Count Qty YasserKhalil.rar

أخي الكريم وهذا حل آخر بالأكواد ... Sub CopyToTablesByYear() Dim SH As Worksheet, WS As Worksheet, Y As Long, F As Range Dim H As Long, I As Long, J As Long, K As Long, R As Long, S As String, D As Range Set WS = Sheets("المبالغ"): Set SH = Sheets("المبالغ مرحله سنوات") S = WS.Range("B2") Y = Left(S, Len(S) - 2) + 2000 I = 2 For R = 2 To WS.Range("B" & Rows.Count).End(xlUp).Row + 1 S = WS.Range("B" & R) If S = "" Then S = "9999" If Left(S, Len(S) - 2) + 2000 = Y Then GoTo GetNext J = R - I Set D = WS.Range("B" & I).Resize(J, 1) Set F = SH.Range("A:A").Find(Y) If F Is Nothing Then Exit Sub If F.Row - J <= K Then SH.Range("A" & F.Row - 1).Resize(K - F.Row + J + 1, 1).EntireRow.Insert End If K = F.Row H = K - J SH.Cells(H, 1).Resize(J, 5).Value = D.Resize(J, 5).Value SH.Cells(H, 14).Resize(J, 1).Value = D.Offset(0, 10).Resize(J, 1).Value I = R: Y = Left(S, Len(S) - 2) + 2000 GetNext: Next R End Sub تقبل تحياتي Transfer Based On Years YasserKhalil.rar

بفرض أن الرقم لديك في الخلية A1 قم باستخدام المعادلة التالية في الخلية B1 مثلاً =DATE(MID(A1,1,4),MID(A1,5,2),MID(A1,7,2)) إذا لم تعمل المعادلة جرب تغير الفاصلة في المعادلة بفاصلة منقوطة تقبل تحياتي

أخي الكريم يبدو أن هناك مشكلة في المرفقات .. المشكلة ظهرت اليوم مع المرفقات الجديدة

الأخت الفاضلة رشا يوسف يرجى عدم تخصيص عضو معين لتقديم المساعدة فلربما كان هناك من هو لديه حلول أفضل .. ويمتنع عن تقديم المساعدة بسبب ذلك الأمر إليكي الكود التالي عله يفي بالغرض Sub DeleteEntireRowForSpecificWords() Dim Rng As Range, Cell As Range, I& On Error Resume Next Set Rng = Application.InputBox("Select Range", "Officena", Selection.Address, Type:=8) Set Rng = Intersect(Rng, Columns(4)) If Rng Is Nothing Then MsgBox "Process Cancelled": Exit Sub Application.ScreenUpdating = False For I = Rng.Rows.Count + Rng.Row - 1 To Rng.Row Step -1 If Cells(I, 4) = "نشاط" Or Cells(I, 4) = "ش+ن" Or Cells(I, 4) = "ادارى" Or Cells(I, 4) = "خط" Or Cells(I, 4) = "كاتب" Then Cells(I, 4).EntireRow.Delete Next I Application.ScreenUpdating = True End Sub Delete Entire Row For Specific Words YasserKhalil.xls