كود يلون الخلية بمجرد إدخال قيمة معينة

[أبوســـارة1973]

أخواني أعضاء المنتدى المحترمون

لقد طلب مني أحد الأصدقاء أن أساعده في الجدول المدرسي ولكني بصراحة لم أستطع إفادته :

فالمطلوب مني هو عمل كود في الملف بمجرد إدخال القيمة ( ت1) في الخلايا من AP68:N4 يتغير لون الخلية إلى اللون الأخضر .

وعند إدخال القيمة ( ت2) في الخلايا من AP68:N4 يتغير لون الخلية إلى اللون الأصفر.

وعند إدخال القيمة ( ت3) في الخلايا من AP68:N4 يتغير لون الخلية إلى اللون الوردي.

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

فكل من يستطيع أن يعمل ذلك فلا يبخل علينا بعلمه وعمله وجزاه الله خيراً

دعائي للجميع بالصحة والعافية والعمر المديد .

أخوكم ابو ساره .

123456.rar

[h63]

السلام عليكم

رايت اخى ابو اسامة

قلت اسبقه باخذ الاجر

فهو حسناته اكثر منى بكثير

تفضل اخى المرفق

هشام

123456.rar

[h63]

السلام عليكم

عفوا المرفق هذا هو الصحيح

وهو يعمل حتى تقريبا 9 شروط

هشام

123456.rar

[ابو اسامة العينبوسي]

السلام عليكم

Dim cell As Range
Dim myrng As Range
Set myrng = Range("n4:ap68")
For Each cell In myrng.Cells
If cell.Value = "ت1" Then
cell.Interior.ColorIndex = 4
End If
If cell.Value = "ت2" Then
cell.Interior.ColorIndex = 6
End If
If cell.Value = "ت3" Then
cell.Interior.ColorIndex = 39
End If
Next cell

او

Dim cell As Range
Dim myrng As Range
Set myrng = Range("n4:ap68")
For Each cell In myrng.Cells
Select Case cell.Value
Case Is = "ت1"
cell.Interior.ColorIndex = 4
Case Is = "ت2"
cell.Interior.ColorIndex = 6
Case Is = "ت3"
cell.Interior.ColorIndex = 39
End Select
Next cell

[ابو اسامة العينبوسي]

السلام عليكم

انت سباق اخى هشام

[h63]

السلام عليكم

اخى واستاذى وقدوتنا الرجل المهذب

اشكرك هذا من فضل الله ثم فضلكم

هشام

[أبوســـارة1973]

ألف شكر لكم أخواني ( H63 ) و ( أبو أسامة )

لكما الأجر إن شاء الله والثواب الجزيل

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

أخي ( H63) أما أنت فقد أبدعت في عملك ولكن عندي ملاحظة عليه وهي أنك إذا إدخلت إحدى القيم المشار إ‘ليها في الكود في إحدى الخلايا المحددة ( N4:AP68) فيعطي النتيجة المطلوبة وبسرعة فائقة أما إذا حذفت القيمة منها فيبقى اللون في الخلية وهذا غير مطلوب فاجتهدت على عملك وأضفت عليه الآتي ( باللون الأحمر )حتى نتغلب على المشكلة التي أشرت إليه :

rivate Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

For Each cell In Range("AP68:N4")

If cell.Value = "" Then

cell.Interior.ColorIndex = xlNone

End If

If cell.Value <> "" Then

Select Case cell.Value

Case "ت1"

cell.Interior.ColorIndex = 4

Case "ت2"

cell.Interior.ColorIndex = 6

Case "ت3"

cell.Interior.ColorIndex = 7

Case "2"

cell.Interior.ColorIndex = 6

Case "3"

cell.Interior.ColorIndex = 5

Case "4"

cell.Interior.ColorIndex = 8

Case "5"

cell.Interior.ColorIndex = 9

Case "6"

cell.Interior.ColorIndex = 10

Case "7"

cell.Interior.ColorIndex = 11

Case " "

cell.Interior.ColorIndex = xlNone

End Select

End If

Next

End Sub

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

ولكن وجدت الكود بهذه الطريقة يعمل بشكل بطيء .

لاحظوا الملف المرفق

1234567.rar

[h63]

السلام عليكم

اخى القاضل نفس المرفق الاساسى بدون تعديل بالكود

وسيفى بالغرض انشاء الله

هشام

123456.rar

[sayied99f]

والله حق كود رائع

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

[ahmedhafez]

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

احمد يكون اللون احمر ولو كان الاسم محمد يكون اصفر وهكذا

[قطان]

أخي الكريم

اسمح لي بالرد

لاحظ الكود الذي يتم التطبيق عليه

For Each cell In Range("AQ68:N4") وهو ما يجب تغييره لـ A1

ويتم تغيير

Case "ت1"

إلى

Case "أحمد"

ويغير اللون من تغيير الرقم

والسلام ختام