اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود لتلوين خلايا مجاورة بناء علي قيمة فى الخلية


الردود الموصى بها

السلام عليكم،

جرب أخي الكود التالي:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1").Value = 1 Then
Range("B1:F1").Select
With Selection.Interior
        .ColorIndex = 5
    End With
End If
End Sub

تم تعديل بواسطه LoveCandle
رابط هذا التعليق
شارك

استاذي الفاضل love candle

اولا وقبل كل شي كل عام وانتم بخير وشهر مبارك جعله له شهر خير علينا وعليكم وعلى امتنا الاسلاميه .

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

وشكرا

رابط هذا التعليق
شارك

جزاك الله خير

إهنئكم بمناسبة دخول رمضان و كل عام وأنتم بخير

أخواني الإعزاء لدي ملاحظات حول الكود

1- الكود لا يعمل بشكل صحيح كما ذكر سابقا من قبل ...

2- أريد لو سمحت اللون تحت الرقم 6 بعد تغيرها من البرمجة

رابط هذا التعليق
شارك

لتعميم الكود علي كامل العمود A

فى ورقة العمل

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

If Range("a" & Target.Row).Value <= 6 Then
  Range("a" & Target.Row).Offset(0, 1).Range("A1:E1").Interior.ColorIndex = 6
Else
  Range("a" & Target.Row).Offset(0, 1).Range("A1:E1").Interior.ColorIndex = 0
End If

End Sub
اذا كتبت اي رقم اقل او يساوي 6 فى العمود رقم A فى اي خلية سيتم تلوين خمسة خلايا مجاورة و اذا كتبت اكثر من 6 سيتم ازالة اللون و يمكنك التحكم فى المعيار من السطر
If Range("a" & Target.Row).Value <= 6 Then

بان تجعله

= 7

<7

>=10

كما يناسبك

كما يوجد حل آخر فى ورقة العمل الثامية باستخدام التنسيق الشرطي

و لكن يعيبه انك اذا تركت الخلية خالية ستتلون الخلايا المجاورة كانها اقل من 6

ColorcellsBasedonVal.zip

رابط هذا التعليق
شارك

السلام عليكم،

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

بالنسبة للكود السابق .. فأنا أتفق معك بأنه غير عملي إطلاقاً .. وقت قمت بإستبداله بهذا الكود والذي أرجوا أن يلبي رغبتك.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1").Value = 1 And Target.Address <> "$A$1" Then
Range("B2:F2").Interior.ColorIndex = 6
ElseIf Range("A1").Value > 1 And Target.Address <> "$A$1" Then
Range("B2:F2").Interior.ColorIndex = xlNone
End If
End Sub

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

شكراً،

___________________________________________1.rar

رابط هذا التعليق
شارك

  • 1 year later...

الاستاذ علي السحيب

لقد استخدمت الكود التالي

'Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'If Range("S5").Value > 179 And Target.Address <> "$s$5" Then

'Range("A5:R5").Interior.ColorIndex = 6

'ElseIf Range("S5").Value < 180 And Target.Address <> "$s$5" Then

'Range("A5:R5").Interior.ColorIndex = xlNone

'End If

'End Sub

السؤال كيف اعمم هذا الكود على جميع الخلايا في العمود "s"

رابط هذا التعليق
شارك

الاستاذ محمد طاهر

لقد استخدمت الكود التالي

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 30 Then Exit Sub

If Range("AD" & Target.Row).Value >= 90 Then

Range("AD" & Target.Row).Offset(-3, -29).Range("A4:AC4").Interior.ColorIndex = 6

Else

Range("AD" & Target.Row).Offset(-3, -29).Range("A4:AC4").Interior.ColorIndex = 0

End If

End Sub

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

اي عندما يكون ناتج المعادلة اكبر من او يساوي 90 يتم التظليل باللون الاصفر ولكن اذا تغير ناتج المعادلة ليصبح 5 او 10 لا يرجع اللون

رابط هذا التعليق
شارك

  • 2 months later...

السلام عليكم

حسنا أكواد جميله ججدا

لكن اذا رغبت بتغيير لون الخلفيه بمجرد تنشيط الخليه

واذا خرجت منها الى خليه اخرى يرجع اللون الافتراضي

:clapping:

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information