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

بارك الله فيك أخي الغالي والمتميز طلعت محمد أخي الكريم أبو علوة أهلاً بك في المنتدى ونورت بين إخوانك يمكنك الدخول على محرر الأكواد عن طريق الضغط على Alt + F11 ومن محرر الأكواد انقر قائمة Insert واختر الأمر Userform .. لمزيد من المعلومات اطرح أسئلة كما تشاء وقم بالإطلاع على الدورات الموجودة في المنتدى ، واستخدم خاصية البحث لأنها ستفيدك بشكل كبير تقبل تحياتي

أخي الكريم حامد (الغد المشرق) وربنا يستر وميحصلش إعصار بكرة وتطلع الدنيا برد وبرق ورعد ومطره وساعتها الشمس لن تشرق حدد النطاق A2:I2 ثم من التبويب Home روح لـ Conditioal Formatting أي التنسيق الشرطي انقر على الأمر New Rule من النافذة ثم ستظهر لكنافذة أخرى اختر منها آخر خيار ألا وهو Use a formula t determine which cells to format ضع المعادلة التالية في الحقل المسمى Format values where this formula is true =COUNTIF(2:2,A2)>1 انقر زر الأمر Format ثم ادخل على التبويب المسمى Fill واختر اللون المطلوب كما تريد أخيراً انقر أوك ثلاثة مرات .. إليك الملف المرفق بعد تطبيق الخطوات السابقة Highlight Duplicates In The Same Row Using Conditional Formatting.rar

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

الحمد لله أن تم المطلوب على خير الحمد لله الذي بنعمته تتم الصالحات إلى لقاء مع موضوع آخر .. تقبل تحياتي

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

أخي الكريم صلاح قينك وفين أراضيك؟؟ بقالك فترة مختفي ..لعل غيابك خير ليك وحشة والله .. مشكور على مرورك العطر بالموضوع

أخي الكريم الشيباني جرب الكود التالي Sub DateTotals() Dim I As Long, Tot As Single For I = Range("G" & Rows.Count).End(xlUp).Row To 6 Step -1 Tot = Tot + Range("G" & I).Value If Range("B" & I).Value <> "" Then Range("H" & I).Value = Tot Tot = 0 End If Next I End Sub Totals VBA YasserKhalil.rar

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

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

بارك الله فيك أخي الغالي بن عليه لكم تعلمنا وما زلنا ننهل من علمك ..جزيت عنا خير الجزاء تقبل تحياتي

أخي الكريم حامد عشان متقولش إننا مقصرين معاك إليك الملف التالي مشابه لطلبك تقريباً .. Multiple Corresponding VLOOKUP Values Across Rows YasserKhalil.rar

أخي الكريم فضل حسين يبدو أنك نسيت إرفاق الملف مع التوضيخ للطلب والتفصيل لكي تتضح الأمور لدى الأخوة الأعضاء

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

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

أخي الكريم ارفق ملفك لتوضيح مسألتك بشكل جيد تقبل تحياتي

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

أخي الكريم حامد يرجى تغيير اسم الظهور للغة العربية بارك الله فيك إليك المعادلة التالية لتعمل على 2003 =IF(ISERROR(VLOOKUP(A20,'كشف توزيع اللجان'!A15:B39,2,FALSE)),"",VLOOKUP(A20,'كشف توزيع اللجان'!A15:B39,2,FALSE)) إذا لم تعمل معك المعادلة قم باستبدال الفاصلة العادية الموجودة بالمعادلة إلى فاصلة منقوطة وحاول تلحق نفسك أوفيس 2016 هو المستخدم الآن .. 2016 - 2003 =13 سنة (أعتقد كفاية كدا على 2003) والناس اللي بتقول إن 2003 خفيف فأقدر أقول إن النسخ الحديثة 2013 و 2016 خفيفة أيضاً أنا عندي جهاز 1 جيجا رامات وبروسيسور عادي وشغال 2016 عليه بشكل كويس جداً تقبل تحياتي

أخي الكريم يمكنك لكي تتلافي تكرار الترحيل أن تقوم بمسح النطاق في ورقة النتائج قبل بدء الترحيل باستخدام Clearcontents .. بالنسبة للشرح يحتاج لوقت وأنا منشغل الآن .. قم بدراسة الكود جبداً وحاول أن تفهم الخطوات وإذا لم تدرك خطوة أو سطر أو جزئية قم بطرحها لنشرحها لك إن شاء الله

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

أخي الكريم أبو يوسف إليك كود آخر أسرع في التعامل مع الملف حيث أنه يعتمد على المصفوفات Sub YasserReport() Application.ScreenUpdating = 0 Dim Arr, Xs$, Brr, Dc, Sn%, D As Object, DD As Object, TT(), SSS() Dim S As Worksheet Dim K, T, C, I As Long, J As Long Set D = CreateObject("scripting.dictionary") Set DD = CreateObject("scripting.dictionary") SSS = Array("المادة", "عدد الطلاب") Xs = ActiveSheet.Name For Each S In Sheets If S.Name <> Xs Then Arr = S.UsedRange: Dc = "" For I = 1 To UBound(Arr, 2) If Len(Arr(19, I)) = 0 Then Arr(19, I) = Arr(19, I - 1) If Len(Arr(21, I)) > 0 Then Dc = Dc & "|" & I Next Dc = Split(Dc, "|") ReDim Brr(1 To UBound(Arr) - 18, 1 To UBound(Dc)) For I = 19 To UBound(Arr) For J = 1 To UBound(Dc) Brr(I - 18, J) = Arr(I, Dc(J)) Next Next Sn = UBound(Brr, 2) - 1 For I = 3 To UBound(Brr) Step 2 For J = Sn - 2 To 1 Step -1 If Val(Brr(I, J)) Then D(Brr(I, Sn) & "|" & Brr(1, J)) = Brr(I, Sn) & "|" & Brr(1, J) & "|" & Brr(I, J) End If Next Next End If Next Debug.Print D.Count K = D.keys T = D.Items For Each C In K DD(Split(C, "|")(0)) = "" Next K = DD.keys ReDim TT(UBound(K)) With Sheets(Xs) [A1] = "اسم المدرسة" [A2].Resize(DD.Count, 1) = Application.Transpose(K) For I = 0 To UBound(K) TT(I) = Filter(T, K(I)) For J = 0 To UBound(TT(I)) Cells(I + 2, J * 2 + 2) = Split(TT(I)(J), "|")(1) Cells(I + 2, J * 2 + 3) = Split(TT(I)(J), "|")(2) Next Next I = [A1].CurrentRegion.Columns.Count For J = 2 To I Step 2 Range(Cells(1, J), Cells(1, J + 1)) = SSS Next Application.ScreenUpdating = 1 End With End Sub وإليك الملف المرفق الأخير Grab Data From Sheets Colored In Red Or White YasserKhalil V2.rar

أخي الكريم يرجى مراجعة التوجيهات من خلال الرابط التالي توجيهات للأعضاء لمعرفة كيفية التعامل مع المنتدى بشكل أفضل التوجيه العاشر على وجه الخصوص تقبل تحياتي

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

أخي الحبيب بن عليه أعتذر إليك حيث أنني لم أرى مشاركتك ولم أنتبه إليها إلا الآن أخي الكريم إليك التعديل البسيط =INDIRECT($B$2&4)*30%

بالفعل أخي الغالي أبا الحسن قد تكون المشكلة في نسخ الكود ..لم أنتبه لهذا الأمر عموماً هذا فيديو يوضح كيف يمكنك نسخ الكود بشكل سليم https://www.youtube.com/watch?v=9X7hlw4G6r8

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