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

وعليكم السلام أخي الكريم أولاً أهلاً بك في المنتدى ونورت بين إخوانك ثانياً ما قدم من قبل أخونا العيدروس هو كود وليس معادلة .. المعادلة توضع في ورقة العمل وتبدأ بعلامة يساوي أما الكود فيوضع في محرر الأكواد في موديول أو في حدث المصنف أو أوراق العمل أو الفورم ثالثاً إذا أردت تغيير العمود فيمكن ذلك من خلال تغيير الكود في سطرين السطر الأول هو رقم العمود الهدف Target.Column <> 1 الرقم 1 في هذا الجزء يشير للعمود الأول .. فإذا أردت التعامل مع العمود E وهو العمود رقم 5 ستقوم بتغيير الرقم 1 إلى الرقم 5 السطر الثاني هو نطاق العمود الأول Fo Each Cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row - 1) قم بتغيير حرف الـ A المعبر عن العمود الأول وضع مكانه حرف العمود المطلوب العمل عليه أرجو أن أكون قد أفدتك

جرب آخر سطرين بهذا الشكل Sheets("Sheet2").Range("E5:G" & Rows.Count).Borders.Value = 0 Sheets("Sheet2").Range("E6").CurrentRegion.Borders.Value = 1

السلام عليكم جرب الملف المرفق .. هل هذا ما تقصده؟ إذا كان غير ذلك قم بإرفاق ملفك مع إعطاء تفاصيل أكثر عن المشكلة تقبل تحياتي Test.rar

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

ربما لأنك لم تشر لورقة العمل قبل النطاق Range المطلوب مسح بياناته

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

بسبب هذا السطر Range("A4:Z1000").Clear إذا أردت مسح البيانات فقط دون التنسيق استخدم ClearContents بدلاً من Clear

أخي العزيز ناصر أنا لا أدري بالضبط شكل المخرجات المطلوبة .. هل الأعمدة الغير متجاورة في النتائج هي المطلوب تسطيرها فقط أم أن نطاق النتائج بالكامل سواء كانت في الأعمدة المتجاورة أو غير المتجاورة هي المطلوبة؟ أعطيتك الدليل ببساطة تشير لورقة العمل ثم النطاق ثم تضع كلمة Borders.Value وبعدها علامة يساوي وتضع القيمة 1 للتسطير والقيمة 0 لإزالة التسطير .. كل ما عليك هو تحديد النطاق المطلوب حاول وإن شاء الله تفلح بالأمر .. وفقك الله لما يحبه ويرضاه

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

لا يتم إلغاء السطر Index فهو يجلب النتائج وبعدها سطر آخر يتم تسطير النتائج به ..

هل تريد تسطير النطاق بالكامل أم كل عمود على حدا .. عموماً جرب السطر التالي بعد السطر الذي يجلب البيانات من ورقة المصدر لورقة الهدف Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Borders.Value = 1

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

جرب الكود التالي Sub Test() Dim sh As Worksheet, i As Long, rng As Range, y, z 'اسم ورقة العمل Set sh = Sheets("Sheet1") Application.ScreenUpdating = False 'مسح النطاق المطلوب وضع النتائج فيه sh.Range("CT8:CT100").ClearContents 'حلقة تكرارية من الصف رقم 8 إلى الصف رقم 100 For i = 8 To 100 'تعيين نطاق لعمود الصافي Set rng = sh.Range("CV" & i) If rng.Value = "" Then rng.Offset(0, -2).Value = "" Else y = Application.WorksheetFunction.Floor(rng.Value, 1) z = Application.WorksheetFunction.Round((rng.Value - y), 2) If z = 0 Then z = "" rng.Offset(0, -2).Value = z End If Next i Application.ScreenUpdating = True End Sub والأفضل وضعه في كود وتنفيذه مرة واحدة فقط .. أفضل من التعامل مع التغير في حدث ورقة العمل إذا أردت التغير في ورقة العمل حاول تدرس الكود وتطبقه بنفسك .. للتدريب (أما أنا لا أحبذ التعامل مع التغير في ورقة العمل في هذه الحالة ، حيث لا داعي لذلك)

أخي الكريم أنصحك بمشاهدة الفيديو التالي .. للأهمية لمعرفة البدايات في التعامل مع الأكواد بعد وضع الكود في موديول داخل محرر الاكواد ..قم بتعديل الاسم الموجودة في الخلية C4 في ورقة التقرير المطلوب العمل عليها ، ثم من لوحة المفاتيح اضغط Alt + F8 واختار اسم الماكرو Test ثم انقر Run وأعتذر عن عدم إرفاق ملف ...حيث أن المنتدى تعليمي وحيث أن مبدأي هو أن يتعلم الناس كيف يصطادون لا أن يأكلوا السمك جاهز .. تقبل تحياتي

تستخدم جملة GoTo للانتقال لخلية محددة في ورقة عمل محددة على سبيل المثال : إذا أردت الذهاب لورق العمل المسماة "شهادة نهاية العام " إلى الخلية L42 يكتب الكود بهذا الشكل Sub Test() Application.Goto Sheets("شهادة نهاية العام ").Range("L42") End Sub أهذا ما تقصده أم تقصد شيئاً آخر؟

جزاك الله خيراً أخي العزيز ناصر على حرصك لنشر العلم .. تقبل وافر تقديري واحترامي

أخي العزيز ناصر .. بعد وضع النتائج في نطاق معين ..على سبيل المثال إذا كانت النتائج تبدأ في الخلية G1 .. يمكنك الاعتماد على النطاق بالشكل التالي الإشارة لورقة العمل + أول خلية بالنطاق أو أي خلية داخل النطاق الذي يحتوي النتائج ثم استخدام خاصية CurrentRegion بهذا الشكل With Sheets("Sheet1").Range("G1").CurrentRegion .............. End With مكان النقاط في الكود يوضع سطر بسيط جداً للتسطير بهذا الشكل .Borders.Value=1 ولإلغاء التسطير استبدل الرقم 1 في السطر السابق بالقيمة صفر .. أرجو أن يفيدك الرد إن شاء الله

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

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

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

وعليكم السلام إذا كان الأمر يخص المسح أضف سطر يقوم بمسح الخلية الهدف والسطر كفيل بإنهاء المشكلة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 Then If Target.Column >= 30 And Target.Column <= 49 Then Application.EnableEvents = False Cells(Target.Row, "AN").Value = "" Cells(Target.Row, "AN").Value = Cells(Target.Row, "AR").Value Application.EnableEvents = True End If End If End Sub ** ملحوظة : يفضل العمل على ملف مرفق واحد فقط معبر عن الملف الأصلي لكي لا يحدث تشتت ..الرجاء الانتباه لتلك الملحوظة تقبل تحياتي

الملف مختلف والعمود الذي يتم نسخ البيانات منه ليس عمود القروش كما في الملف الذي تم العمل عليه ، وحاولت فهم المطلوب في الملف الجديد لكن غير واضح أين عمود القروش المطلوب نسخه؟

وعليكم السلام ضع الكود التالي في حدث ورقة العمل (كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code والصق الكود التالي) قم بوضع أية بيانات في الأعمدة من AD إلى AW ولاحظ النتيجة في العمود AN Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 Then If Target.Column >= 30 And Target.Column <= 49 Then Application.EnableEvents = False Cells(Target.Row, "AN").Value = Cells(Target.Row, "AR").Value Application.EnableEvents = True End If End If End Sub