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

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

بارك الله فيك أخي سليم طالما أنك تتعامل مع الأكواد فيستحب تحويل المعادلة لقيمة إضافة بسيطة جداً لكودك الرائع للحصول على قيم فقط Sub montougat() [a5] = [b1] [b5:c5].Formula = "=INDEX(Sheet1!$B$2:$C$100,MATCH($A5,Sheet1!$A$2:$A$100,0),MATCH(B$4,Sheet1!$B$1:$C$1,0))" [b5:c5].Value = [b5:c5].Value [a10] = [b1] [b10:c10].Formula = "=INDEX(Sheet2!$B$2:$D$100,MATCH($A10,Sheet2!$A$2:$A$100,0),MATCH(B$9,Sheet2!$B$1:$D$1,0))" [b10:c10].Value = [b10:c10].Value End Sub وذلك تخفيفاً من حجم الملف في حالة التعامل مع بيانات كثيرة.. تقبل تحياتي

إنت تؤمر أخي وحبيبي صلاح إنت تسأل ونحن نجيب بإذن الله قل بفضل الله .. وقل الحمد لله تقبل تحياتي

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

أخي وحبيبي ومعلمي دغيدي اجعل الـ Calculations يدوي من التبويب Formulas ثم Calculation Options ثم اختر manual وأفضل أن تستبدل المعادلات في الملف بأكواد طالما أن الأمر يستغرق وقتاً طويلاً .. فهذا أسرع في التعامل مع الملف وأخف في الحجم ومميزات أخرى ستكتشفها عندما تتعامل مع الأكواد وابتعد قدر الإمكان عن معادلات الصفيف .. فهي تجعل من الملف كارثة مع كثرة البيانات تقبل تحياتي

الأخ الكريم صلاح الدين سعيد مبروك عليك الاسم الجديد إليك الكود التالي عله يكون المطلوب Sub MyReport() Dim SN, I As Long, J As Long, N As Long Sheets("إجمالي").Range("A1:B1000").ClearContents SN = Sheets("إدخال").Range("H1:AU" & Sheets("إدخال").Cells(Rows.Count, 8).End(xlUp).Row) ReDim Arr(UBound(SN) * UBound(SN, 2), 2) For I = 2 To UBound(SN) For J = 1 To UBound(SN, 2) Step 2 If SN(I, J) <> "" Then Arr(N, 0) = SN(I, J) Arr(N, 1) = SN(I, J + 1) N = N + 1 End If Next J Next I With Sheets("إجمالي") .Cells(2, 1).Resize(N, 2) = Arr .Cells(1, 1) = "اسم الصنف": .Cells(1, 2) = "الكمية المنصرفة" End With End Sub يرجى إذا كان فيه طلب جديد طرح موضوع جديد ..ليكون كل موضوع بطلب مستقل .. هذا لأن طلبك الثاني مختلف عن الأول (لكن عشان جديد وعشان سمعت الكلام وغيرت اسمك للغة العربية .. محبتش أتقل عليك) لا تنسى الالتزام بالتوجيهات على هذا الرابط (من هنا) ، وتحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي Recipe YasserKhalil.rar

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

أخي الغالي سليم لما استخدام الحلقات التكرارية هنا Sub TypeSpecificWord() Range("C2:C" & Rows.Count).ClearContents With Range("C2:C" & Cells(Rows.Count, "B").End(xlUp).Row) .Value = "ناجح" End With End Sub يمكن ببساطة استخدام الكود بهذا الشكل

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

لم أفهم المشكلة وضح بشكل أكثر دقة .. المعاين مضبوط حسب ما تقدمت به في الكود أي أن النطاق (منطقة الطباعة) سيكون A1:L10 طبقاً لملفك

جرب الكود بهذا الشكل Sub Transfer() Application.ScreenUpdating = False On Error Resume Next Dim Cell As Range, T As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long Set WS = Sheets("1") LR = WS.Cells(35, 3).End(xlUp).Row T = WS.Range("A3").Value Application.ScreenUpdating = False WS.Unprotect "2191612" If Not IsEmpty(WS.Range("c6")) Then With Sheets(T) .Unprotect "2191612" LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 WS.Range("B6:G" & LR).Copy .Cells(LRT, 2).PasteSpecial xlPasteValues .Protect "2191612" End With Answer = MsgBox("تم ترحل البيانات .....هل تريد أن مسح البيانات المرحلة؟", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("1").Activate Sheets("1").Range("A3,C6:C35,F6:G35").Select Selection.ClearContents Else MsgBox "!! لم يتم الحذف" End If Sheets("1").Select ActiveWindow.SmallScroll Down:=-12 Range("A3,C6").Select Else MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub End If WS.Protect "2191612" Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

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

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

أخي الفاضل ... هل يصعب عليك إرفاق ملف؟

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

جرب الكود Sub معاينه5() Dim BB As Integer BB = Range("عدد_الأوراق") ActiveSheet.PageSetup.PrintArea = "$A$1:$L$" & BB ActiveWindow.SelectedSheets.PrintPreview [A7].Select End Sub

قم بإرفاق ملفك أخي الكريم ليساعدك الأخوة الأعضاء

ضع نقطة قبل كلمة Protect أنا لم أجرب الكود لأنك لم ترفق ملف .. .Protect "2191612" أتمنى تكون المشكلة اتحلت

روح لمحرر الأكواد عن طريق Alt + F11 ومن قائمة Tools اختر References وأزل علامات الصح بجانب الخيارات التي تجدها باسم Missing ثم أوك OK واحفظ المصنف

السلام عليكم ورحمة الله وبركاته شرح عمل نطاق ديناميكي أو قائمة مطاطية Dynamic Range أول شيء سنقوم به هو تسمية نطاق أرقام الجلوس ، وهنتعلم إزاي نخلي النطاق ديناميكي يعني مش ثابت من خلية محددة إلى خلية أخرى محددة ، كل اللي هنعمله إننا هنحدد أول خلية ، أما آخر خلية به رقم جلوس فدي هتتحدد بشكل ديناميكي ؛ عشان لو زودت أرقام جلوس يتغير النطاق بدون تدخل منك >> بندخل على التبويب Formulas ثم Name Manager ونضغط New (سأقوم بحذف كل النطاقات الغير هامة أو مكررة) ونكتب في حقل Name اسم النطاق هنسميه (رقم_الجلوس) ، وفي الحقل المسمى Refers to هنكتب المعادلة بهذا الشكل : ='كنترول شيت'!$B$11:INDEX('كنترول شيت'!$B$11:$B$500,COUNTA('كنترول شيت'!$B$11:$B$500)) الجزء الأول في المعادلة بيحدد بداية النطاق ألا وهو الخلية B11 وبما إن خلية البداية لازم تكون ثابتة فبنضيف علامات الدولار قبل اسم العمود ورقم الصف لتصبح بهذا الشكل $B$11 نلاحظ في المعادلة إنه بيتم الإشارة إلى ورقة العمل اللي فيها النطاق ، وورقة العمل هي "كنترول شيت" ، والتي تحتوي على أرقام الجلوس في العمود B بداية من الخلية B11 بعدما حددنا خلية البداية وضعنا : (نقطتين فوق بعض) عشان الجزء اللي ورا النقطتين فوق بعض هو دا المسئول عن تحديد آخر خلية في النطاق الجزء الثاني في المعادلة (المسئول عن البحث عن آخر رقم جلوس في النطاق) INDEX('كنترول شيت'!$B$11:$B$500,COUNTA('كنترول شيت'!$B$11:$B$500)) الدالة INDEX دالة فهرسة أو بحث ، ودي ليها ثلاثة بارمترات : ** البارامتر الأول عبارة عن مصفوفة لقيم النطاق .. يعني لو خدنا السطر السابق ووضعناه في خلية ووضعنا علامة يساوي قبله (الناتج هيكون آخر رقم جلوس في النطاق) ولو جينا بعد القوس المفتوح بعد اسم الدالة INDEX ووضعنا مؤشر الكتابة بيظهر تلميح مع المعادلة .. هتلاقي كلمة Array في التلميح بلون أسود عريض Bold انقر عليه بالماوس ، هيحدد لك في المعادلة مصفوفة القيم اللي هي في مثالنا 'كنترول شيت'!$B$11:$B$500 هو دا نطاق أرقام الجلوس .. واستخدمنا هنا رقم 500 كحد أقصى للبيانات ، ممكن نغير رقم 500 إلى أي رقم أكبر زي 1000 أو أكتر .. نيجي نضغط F9 من لوحة المفاتيح بعد ما حددنا الجزء ده في المعادلة هنلاقي قيم النطاق بالكامل بما فيها الخلايا الفارغة ، الخلايا الفارغة هتاخد القيمة صفر ، وبقية القيم هي عبارة عن أرقام الجلوس {1983;1984;1985;1986;1987;1988;1989;1990;1991;1992;1993;1994;1995;1996;1997;1998;1999;2000;2001;2002;2003;2004;2005;2006;2007;2008;2009;2010;2011;2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023;2024;2025;2026;2027;2028;2029;2030;2031;2032;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0} هو دا شكل القيم داخل المصفوفة .. طبعاً عشان نلغي اللي عملناه نضغط Ctrl + Z من لوحة المفاتيح للتراجع (الحركة اللي عملناها عشان نفهم شكل المصفوفة التي سيتم البحث داخلها) ** البارامتر الثاني وهو لمعرفة عدد الصفوف ، والمطلوب إننا نجيب عدد الصفوف التي تحتوي على قيم فقط (الخلايا التي تحتوي على قيم دون الأصفار) وهنا تم استخدام دالة COUNTA ودي دالة سهلة لعد القيم دون الفراغات ، وسيتم عد نفس النطاق COUNTA('كنترول شيت'!$B$11:$B$500) ولو ضغطنا F9 من لوحة المفاتيح هنلاقي الناتج لهذا الجزء هو 50 أي أن عدد أرقام الجلوس 50 ** البارامتر الثالث وهو اختياري ولم يتم الإشارة إليه في المعادلة وهو عدد الأعمدة ، ودا هنا الإكسيل بيفهم إن عدد الأعمدة واحد فقط لأننا شغالين على عمود واحد فقط ألا وهو العمود B. لو عايز تعرف شكل النطاق بعد وضع المعادلة ادخل على Name Manager وحدد اسم النطاق (رقم_الجلوس) ثم انقر على كلمة Edit ثم أخيراً انقر على السهم الأحمر على يمين المعادلة ، ستجد أن الإكسيل سيقوم بتحديد النطاق الديناميكي .. قم بإضافة أرقام جلوس أخرى ، وعيد نفس الخطوات وشوف النتيجة بنفسك (ستجد أن النطاق ديناميكي وليس ثابت)

أخي الحبيب سليم راجع الملف مرة أخرى .. لا يوجد أكواد ولا يتم إخفاء العمود B و C كما ذكرت .. أخي الكريم أحمد فؤاد لإخفاء محتويات الخلايا أو الصفوف أو الأعمدة التي تريد إخفائها قم بتحديد الخلايا ثم كليك يمين ثم تنسيق خلايا Format Cells ثم اختر Custom ثم في الحقل المسمى Type: اكتب ;;; يمكنك مشاهدة الفيويو التالي تقبلوا تحياتي

جرب الكود بهذا الشكل Sub Transfer() Application.ScreenUpdating = False On Error Resume Next Dim Cell As Range, T As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long Set WS = Sheets("1") LR = WS.Cells(35, 3).End(xlUp).Row T = WS.Range("A3").Value Application.ScreenUpdating = False WS.Unprotect "2191612" If Not IsEmpty(WS.Range("c6")) Then Range("B6:G" & LR).Copy With Sheets(T) .Unprotect "2191612" LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 .Cells(LRT, 2).PasteSpecial xlPasteValues Protect "2191612" End With Answer = MsgBox("تم ترحل البيانات .....هل تريد أن مسح البيانات المرحلة؟", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("1").Activate Sheets("1").Range("A3,C6:C35,F6:G35").Select Selection.ClearContents Else MsgBox "!! لم يتم الحذف" End If Sheets("1").Select ActiveWindow.SmallScroll Down:=-12 Range("A3,C6").Select Else MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub End If WS.Protect "2191612" Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي

أخي الكريم أبو عبد الملك إليك الدالة التالية وهي مشروحة في موضوع افتح الباب وكل كباب في صفحة المنتدى الرئيسية Function Level(Mark As Variant) As String Select Case Mark Case "" Level = "" Case 0 To 29 Level = "راسب بتقدير إنذار" Case 30 To 39 Level = "راسب بتقدير توبيخ" Case 40 To 49 Level = "راسب بتقدير ضعيف جداً" Case 50 To 59 Level = "راسب بتقدير ضعيف" Case 60 To 69 Level = "ناجح بتقدير حسن" Case 70 To 79 Level = "ناجح بتقدير جيد" Case 80 To 89 Level = "ناجح بتقدير جيد جداً" Case 90 To 97 Level = "ناجح بتقدير ممتاز" Case 98 To 100 Level = "ناجح بتقدير ممتاز جداً" Case "غ" Level = "غ" End Select End Function بالنسبة لحجم الملف إلى الآن 107 كيلو بايت .. كم نسبة الإنجاز إلى الآن ؟؟ (كفاية كدا على الموضوع ده ... يرجى طرح موضوع جديد .. لن أقبل بأي طلبات جديدة في هذا الموضوع) تقبل تحياتي Quran School V7.rar

أخي الحبيب علاء رسلان أشهد الله أني أحبك في الله إليك هذه الهدية وإن شاء الله تكون مقبولة نظراً لأن معادلات الصفيف تسبب ثقل في الملف وتزيد من حجمه خصوصاً إذا كانت البيانات كبيرة بشكل ملحوظ أقدم لك حل بالأكواد .. وجرب بيانات كثيرة مع الملف المرفق وشوف النتائج بنفسك .. Sub ExtractUsingArrays() Dim X, Y(), T(), I& With Sheets("إدخال") .Range("H2:BH1000").ClearContents X = .Range("C2:D" & .Cells(Rows.Count, 3).End(xlUp).Row).Value End With ReDim Y(1 To UBound(X), 1 To 2) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For I = 1 To UBound(X) .Item(X(I, 1)) = Array(I, X(I, 2), 0) Next I With Sheets("Recipe") X = .Range("B1:G" & .Cells(Rows.Count, 2).End(xlUp).Row).Value End With For I = 2 To UBound(X) If .Exists(X(I, 1)) Then T = .Item(X(I, 1)): T(2) = T(2) + 2 If T(2) > UBound(Y, 2) Then ReDim Preserve Y(1 To UBound(Y), 1 To UBound(Y, 2) + 2) Y(T(0), T(2) - 1) = X(I, 2): Y(T(0), T(2)) = X(I, 6) * T(1) .Item(X(I, 1)) = T() End If Next I End With Sheets("إدخال").Range("H2").Resize(UBound(Y), UBound(Y, 2)).Value = Y Sheets("إدخال").Columns("H:AU").AutoFit End Sub تقبل هديتي وتحياتي Extract Data Using Arrays YK.rar

تفضل أخي الكريم قمت بإدراج صف فارغ بين القيم وبين أول خلية بها معادلة لتضبط المعادلة وإلا ظهر خطأ في نهاية النتائج New File.rar