مطلوب كود تنسيق شرطى لأعمدة كل عمود بشرط غير الآخر

[يوسف عطا]

مشكور يا الغالى الخالدى بك

جازاك الله خير

وكل عام وأنتم بخير

[يوسف عطا]

عزيزى الخالدى بك

كل عام وسيادتكم بخير

ما العمل لو كنت سأستخدم الكود مع نتائج معادلات ؟؟

هل يمكن التغلب على هذه المشكلة ؟؟

[يوسف عطا]

أخويا الغالى الخالدى بك

كل عام وأنتم بخير

السنة الجاية تكون واقف على عرفات

حبيت أطبق الكود على الملف بتاعى فظهر إرور وتم تلوين السطر الثالث من الكود باللون الأصفر

الكود كما وضعته بالملف هو

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rn As Range, cl As Range

Set Rn = Intersect(Target, Range("K11:K2000,L11:L2000,O11:O2000,P11:P2000,Q11:Q2000,R11:R2000,V11:V2000,W11:W2000,Z11:Z2000,AA11:AA2000,AB11:AB2000,AC11:AC2000,AG11:AG2000,AH11:AH2000,AK11:AK2000,AL11:AL2000,AM11:AM2000,AN11:AN2000,AS11:AS2000,AT11:AT2000,AY11:AY2000,AZ11:AZ2000,BA11:BA2000,BB11:BB2000,BG11:BG2000,BH11:BH2000,BM11:BM2000,BN11:BN2000,BO11:BO2000,BP11:BP2000,BT11:BT2000,BU11:BU2000,BX11:BX2000,BY11:BY2000,BZ11:BZ2000,CA11:CA2000,CF11:CF2000,CG11:CG2000,CL11:CL2000,CM11:CM2000,CN11:CN2000,CO11:CO2000,CQ11:CQ2000,CR11:CR2000,CS11:CS2000,CT11:CT2000,CU11:CU2000,CV11:CV2000,CW11:CW2000,CX11:CX2000,CY11:CY2000,CZ11:CZ2000,DA11:DA2000,DC11:DC2000,DG11:DG2000,DH11:DH2000,DK11:DK2000,DL11:DL2000,DM11:DM2000,DN11:DN2000,DR11:DRY2000,DS11:DS2000,DV11:DV2000,DW11:DWY2000,DX11:DX2000,DY11:DY2000"))

If Not Rn Is Nothing Then

Rn.Interior.ColorIndex = xlNone

For Each cl In Rn

If cl = "غ" Then

cl.Interior.ColorIndex = 42

Else

If cl < Cells(10, cl.Column) Then cl.Interior.ColorIndex = 44

End If

Next

End If

Set Rn = Nothing

End Sub

هل السبب زيادة عدد الأعمدة المطلوب التنسيق فيها ؟؟

ولو كان هذا هو السبب فما العمل ؟؟ علماً بأننى جربت الكود على ملف ليس به معادلات

أم هناك سبب آخر ؟؟

وما العمل لحل هذه المشكلة ؟

تم تعديل أكتوبر 24, 2012 بواسطه يوسف عطا

[الخالدي]

اخي العزيز يوسف

كل عام وانتم بخير

نسال الله لنا جميعا الوقوف بعرفات

في البداية ارجوا تعديل السطر في الكود الاول من مشاركتي السابقة من

If cl < Cells(10, cl.Column) Then cl.Interior.ColorIndex = 44

الي (السبب حتى لا يتم تلوين الخلايا الفارغة)

If cl <> "" And cl < Cells(10, cl.Column) Then cl.Interior.ColorIndex = 44

---------------------------------

اما عن سبب الخطأ في الكود

فمن خلال تجربتي للكود لوحظ انه عندما تكون النطاقات المحددة داخل Range() تزيد احرفها عن 256 حرفا يظهر خطأ في الكود , واعتقد ان هذا سبب الخطأ

والحل باعتقادي يكون من خلال استخدام اكثر من Range() بحيث توضع داخل كلا منها عدد من النطاقات ثم يقوم الكود بمعالجة كل مجموعة على حده.

ملاحظة : تأكد من صحة النطاقات DR11:DRY2000 و DW11:DWY2000 في Range() فربما انك تعني تحديد النطاقات DR11:DR2000 و DW11:DW2000

---------------------------------

بخصوص سؤالك في المشاركة قبل السابقة - ما العمل لو كنت سأستخدم الكود مع نتائج معادلات ؟؟

حقيقة لا اعلم الحل ربما يجود الاخوة بحل مناسب

واقترحي لحل الموضوع:

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

ويكون ذلك بتعديل Target الى Target.EntireRow في الكود الاول

اما اذا كانت المعادلات مرتبطة بخلايا ليست على نفس الصف وايضا قد تكون مرتبطة بأوراق اخرى فاعتقد الحل يكون بوضع الكود في حدث Private Sub Worksheet_Calculate() واذا كان هناك بعض الخلايا يتم الادخال فيها بدون معادلات فيلزم هنا ايضا كود في حدث التغير بالورقة , الكود مع الحدث الحساب Calculate سيكون بطي لان الكود سينفذ على كل خلايا النطاق المحدد

في أمان الله

[يوسف عطا]

أخى الخالدى

بعد السلام والتحية

أشكرك لتفاعلك مع مشكلتى ومحاولة حلها

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

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

أم هل تقصد أن يصبح الكود عدة أكواد وكل منها يقوم بالعمل على جزء من النطاقات

جارى التجربة مرة أخرى

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

مما سيجعل الأمر أصعب مما كنت أتوقع

ولكن بما أنه لا يفتى ومالك فى المدينة

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

وعلى كل حال فالتجربة قد تبلغ الأمل والرجاء وإن لم تفعل فشرف المحاولة كاف للتلاميذ أمثالى

وفقكم الله وسدد خطاكم

سوف أعرض عليكم تجاربى فى هذا الأمر

والشكر موصول لكم ولكل من سيساهم فى إثراء هذا الموضوع الهام

[يوسف عطا]

للاسف فشلت فى تقسيم الكود بالطريقتين

الأولى عن طريق تقسيم الأعمدة بأكثر من متغير

الثانية عن طريق تكرار لعدة أكواد الكود ليعمل فى كل كود على عدة أعمدة

الرجاء المساعدة فى هذا الأمر ومرة أخرى هذه هى الأعمدة المراد التطبيق عليها

("K11:K2000,L11:L2000,O11:O2000,P11:P2000,Q11:Q2000,R11:R2000,V11:V2000,W11:W2000,Z11:Z2000,AA11:AA2000

AB11:AB2000,AC11:AC2000,AG11:AG2000,AH11:AH2000,AK11:AK2000,AL11:AL2000,AM11:AM2000,AN11:AN2000,AS11:AS2000,AT11:AT2000,AY11:AY2000,AZ11:AZ2000

BA11:BA2000,BB11:BB2000,BG11:BG2000,BH11:BH2000,BM11:BM2000,BN11:BN2000,BO11:BO2000,BP11:BP2000,BT11:BT2000,BU11:BU2000,BX11:BX2000,BY11:BY2000,BZ11:BZ2000

CA11:CA2000,CF11:CF2000,CG11:CG2000,CL11:CL2000,CM11:CM2000,CN11:CN2000,CO11:CO2000,CQ11:CQ2000,CR11:CR2000,CS11:CS2000,CT11:CT2000,CU11:CU2000,CV11:CV2000,CW11:CW2000,CX11:CX2000,CY11:CY2000,CZ11:CZ2000

DA11:DA2000,DC11:DC2000,DG11:DG2000,DH11:DH2000,DK11:DK2000,DL11:DL2000,DM11:DM2000,DN11:DN2000,DR11:DR2000,DS11:DS2000,DV11:DV2000,DW11:DW2000,DX11:DX2000,DY11:DY2000")

تم تعديل أكتوبر 27, 2012 بواسطه يوسف عطا

[الخالدي]

السلام عليكم ورحمة الله وبركاته

في الكود التالي وضعت النطاقات في اكثر من Range

Private Sub Worksheet_Change(ByVal Target As Range)

Set Rn = Range("K11:K2000,L11:L2000,O11:O2000,P11:P2000,Q11:Q2000,R11:R2000,V11:V2000,W11:W2000,Z11:Z2000,AA11:AA2000")

Set Rn = Union(Rn, Range("AB11:AB2000,AC11:AC2000,AG11:AG2000,AH11:AH2000,AK11:AK2000,AL11:AL2000,AM11:AM2000,AN11:AN2000,AS11:AS2000,AT11:AT2000,AY11:AY2000,AZ11:AZ2000"))

Set Rn = Union(Rn, Range("BA11:BA2000,BB11:BB2000,BG11:BG2000,BH11:BH2000,BM11:BM2000,BN11:BN2000,BO11:BO2000,BP11:BP2000,BT11:BT2000,BU11:BU2000,BX11:BX2000,BY11:BY2000,BZ11:BZ2000"))

Set Rn = Union(Rn, Range("CA11:CA2000,CF11:CF2000,CG11:CG2000,CL11:CL2000,CM11:CM2000,CN11:CN2000,CO11:CO2000,CQ11:CQ2000,CR11:CR2000,CS11:CS2000,CT11:CT2000,CU11:CU2000,CV11:CV2000,CW11:CW2000,CX11:CX2000,CY11:CY2000,CZ11:CZ2000"))

Set Rn = Union(Rn, Range("DA11:DA2000,DC11:DC2000,DG11:DG2000,DH11:DH2000,DK11:DK2000,DL11:DL2000,DM11:DM2000,DN11:DN2000,DR11:DR2000,DS11:DS2000,DV11:DV2000,DW11:DW2000,DX11:DX2000,DY11:DY2000")"))

Set Rn = Intersect(Target, Rn)

If Not Rn Is Nothing Then

Rn.Interior.ColorIndex = xlNone

For Each cl In Rn

If cl = "غ" Then

cl.Interior.ColorIndex = 42

Else

If cl <> "" And cl < Cells(10, cl.Column) Then cl.Interior.ColorIndex = 44

End If

Next

End If

Set Rn = Nothing

End Sub

في الكود التالي وضعت النطاقات في Range واحد وبعدد احرف لا تزيد عن 256 حرفا حيث: تم وضع الاعمدة المتجاورة مثل K11:K2000 و L11:L2000 في نطاق واحد K11:L2000 عدم كتابة ارقام الصفوف مثل K11:L2000 اصبح K:L ثم بعد ذلك تم تحديد صفوف النطاقات من خلال التقاطع مع Range("11:2000")

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rn As Range, cl As Range

Set Rn = Intersect(Target, Range("11:2000") , Range("K:L,O:O,P:R,V:V,V:W,Z:Z,AA:AC,AG:AG,AG:AH,AK:AK,AL:AN,AS:AS,AS:AT,AY:AY,AZ:BB,BG:BG,BG:BH,BM:BM,BN:BP,BT:BT,BT:BU,BX:BX,BY:CA,CF:CF,CF:CG,CL:CL,CM:CO,CQ:CQ,CR:DA,DC:DC,DG:DG,DG:DH,DK:DK,DL:DN,DR:DR,DR:DS,DV:DV,DW:DY"))

If Not Rn Is Nothing Then

Rn.Interior.ColorIndex = xlNone

For Each cl In Rn

If cl = "غ" Then

cl.Interior.ColorIndex = 42

Else

If cl <> "" And cl < Cells(10, cl.Column) Then cl.Interior.ColorIndex = 44

End If

Next

End If

Set Rn = Nothing

End Sub

استخدم احدى الطرقتين

في أمان الله

[يوسف عطا]

أفكارك عظيمة أخى الخالدى

جارى التجربة

[يوسف عطا]

بحق يا الغالى

تسلم إيدك

وللعلم فالكود يعمل حتى لو كانت الخلايا المطلوب تلوينها بها معادلات

سواء معادلات مباشرة أو معادلات من أوراق أخرى

بحق الله ينور على معاليكم

[يوسف عطا]

لا أعرف لماذا يعمل الكود جيداً فى حالة التجربة فى ملف جديد

ولكن عند إضافته للملف المطلوب العمل عليه لا يعمل

جارى محاولة معرفة السبب وإخباركم بالنتيجة