تعديل على كود تلوين الخلية المتساوية مع أخرى من نفس العمود

أبوســـارة1973 · أكتوبر 30, 2009

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

For Each cell In Range("n8:v80")

If cell.Value = "" Then

cell.Interior.ColorIndex = xlNone

End If

If cell.Value <> "" Then

Select Case cell.Value

case cell = cell then

cell.Interior.ColorIndex = 4

End Select

End If

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

هذا كود يقوم بتلوين الخلية في حالة إدخال قيمة متساوية مع قيمة خلية أخرى في نفس العمود من المدى المحدد(n8:v80)

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

فمن يعدل الكود جزاه الله عني خير الجزاء ؟

تم تعديل أكتوبر 30, 2009 بواسطه abusarah73

أبوســـارة1973 · أكتوبر 30, 2009

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

أملي في الخبراء والمشرفين كبير وثقتي فيهم تامة

**عبدالله باقشير** · أكتوبر 30, 2009

السلام عليكم

تم عمل كود يتناسب مع طلبك

Private Sub Worksheet_Change(ByVal Target As Range)

Dim R As Integer, C As Integer

If Not Intersect(Target, Range("N8:V80")) Is Nothing Then

If Target.Count > 1 Then Target.Interior.ColorIndex = xlNone: Exit Sub

    Target.Interior.ColorIndex = xlNone

    If Target.Value = "" Then Exit Sub

    For R = 8 To 80

        If R <> Target.Row And Target = Cells(R, Target.Column) Then

            Target.Interior.ColorIndex = 4

        End If

    Next

End If

End Sub

تفضل المرفق

تلوين خلية في عمود بشرط.rar

تم تعديل أكتوبر 31, 2009 بواسطه خبور خير

أبوســـارة1973 · أكتوبر 31, 2009

ألف شكر لك أستاذي العزيز خبور

كنت واثقاً بأنك من سيساعدني في تعديل هذا الكود

ولكن اسمح لي بأن أطلب منك أكثر فلقد لاحظت ما يلي :

1- أن هذا الكود يقوم بتلوين كل الخلايا التي تتساوى في قيمهما ماعدا الخلية التي أدخلت أولاً .(مطلوب تلوينا أيضا )

2- عند حذف أو تغير قيمة الخلية التي أدخلت أولاً فإنه لا يقوم بإعادة الخلايا( التي أدخلت بعد ثانياأو ثالثاً أو ...) لوضعها الطبيعي ( بدون تلوين ).

أي لو أدخلنا في الخلية a10 رقم 1 ثم أدخلنا في الخلية a20 رقم 1 فيقوم بتلوين الخلية رقم a20 فقط ولا يلون الخلية a10 ولو حذفنا الرقم 1 أو بدلناه إلى الرقم 11 فتبقى الخلية رقم a20 ملونة والملطلوب هنا حذف التلوين وإعادتها لوضعها الطبيعي .

مع خالص شكري واعذرني إذا أثقلت عليك بعض الشيء

أخوك أبو سارة

**عادل حنفي** · أكتوبر 31, 2009

السلام عليكم

اخي abusarah73

اضافة لحل الاستاذ والاخ الحبيب خبور

الحل بطريقة اخري للافاده

الكود:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row < 8 Then Exit Sub

If Target.Row > 80 Then Exit Sub

If Target.Column < 14 Then Exit Sub

If Target.Column > 22 Then Exit Sub

h = Target.Value

x = Target.Column

L = Target.Row

s = Target.Address

If h <> "" Then

For i = 8 To 80

If Cells(i, x).Value <> "" Then

If Cells(i, x).Row <> L Then

If Cells(i, x).Value = h Then

Cells(i, x).Interior.ColorIndex = 4

GoTo 1

Else

Target.Interior.ColorIndex = xlNone

End If

End If

End If

Next

Exit Sub

1:

Range(s).Select

Range(s).Interior.ColorIndex = 4

End If

End Sub

خالص تحياتي

تحديد خلايا بلون عند التشابه1.rar

تم تعديل أكتوبر 31, 2009 بواسطه aah_aah2008

**عبدالله باقشير** · أكتوبر 31, 2009

السلام عليكم

الشكر واصل للاخ/ عادل

الاخ/ ابو سارة

أي لو أدخلنا في الخلية a10 رقم 1 ثم أدخلنا في الخلية a20 رقم 1 فيقوم بتلوين الخلية رقم a20 فقط ولا يلون الخلية a10 ولو حذفنا الرقم 1 أو بدلناه إلى الرقم 11 فتبقى الخلية رقم a20 ملونة والملطلوب هنا حذف التلوين وإعادتها لوضعها الطبيعي .

تم تعديل الكود حسب طلبك :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim R As Integer, C As Integer

If Not Intersect(Target, Range("N8:V80")) Is Nothing Then

    Application.ScreenUpdating = False

    C = Target.Column

    For R = 8 To 80

        If Cells(R, C) <> "" And Application.CountIf(Range(Cells(8, C), Cells(80, C)), Cells(R, C)) > 1 Then

            Cells(R, C).Interior.ColorIndex = 4

        Else

            Cells(R, C).Interior.ColorIndex = xlNone

        End If

    Next

    Application.ScreenUpdating = True

End If

End Sub

شاهد المرفق

تلوين خلية في عمود بشرط.rar

ايت الحبيب · نوفمبر 2, 2009

اطلب من اخي كود يمكن من تلوين عمود مثلا من A2 الى A50 عند وضع نجمة ( * ) في الخلية A1

تم تعديل نوفمبر 2, 2009 بواسطه aitlahbib

ايت الحبيب · نوفمبر 2, 2009

اطلب من اخي كود يمكن من تلوين عمود مثلا من A2 الى A50 عند وضع نجمة ( * ) في الخلية A1

**عادل حنفي** · نوفمبر 2, 2009

السلام عليكم

اخي جرب المرق

الشرح داخل الملف

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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

Application.ScreenUpdating = False

If Range("a1") = "*" Then

GoTo 1

Else

GoTo 2

End If

1:

Application.ScreenUpdating = False

Range("A2:A50").Interior.ColorIndex = 4

Application.ScreenUpdating = True

Exit Sub

2:

Application.ScreenUpdating = False

Range("A2:A50").Interior.ColorIndex = xlNone

Application.ScreenUpdating = True

End Sub

جرب و اخبرني النتيجة

تحياتي

COLUMN COLOR.rar

تم تعديل نوفمبر 2, 2009 بواسطه aah_aah2008

ايت الحبيب · نوفمبر 3, 2009

السلام عليكم

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

تم تعديل نوفمبر 3, 2009 بواسطه aitlahbib

**عادل حنفي** · نوفمبر 6, 2009

السلام عليكم

اخي الكود بعد التعديل وفقا لطلبك


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


If Target.Column <> 1 Then Exit Sub

Application.ScreenUpdating = False

If Range("a1") = "*" Then

GoTo 1

Else

GoTo 2

End If

1:

Application.ScreenUpdating = False

Columns("a:ae").Interior.ColorIndex = 4

Application.ScreenUpdating = True

Exit Sub

2:

Application.ScreenUpdating = False

Columns("a:ae").Interior.ColorIndex = xlNone

Application.ScreenUpdating = True

End Sub

مرفق ملف بالتعديل

COLUMN COLOR.rar

أبوســـارة1973 · نوفمبر 7, 2009

الأستاذ : خبور خير

الأستاذ : عادل

جزاتكما الله خير الجزاء وآسف على تأخري في تقديم الشكر لكما

ايت الحبيب · نوفمبر 8, 2009

السلام عليكم

جزاك الله بخير على هذه المجهوكات التي تقدمها لي الا انني لم اتمكن من ان اوصل لك غايتي :

انا ارغب في ما يلي :

- كلما وضعت (*) في اول العمود A1 يلون العمود من A2 الى A50 فقط

- كلما وضعت (*) في اول العمود B1 يلون العمود من B2 الى B50 فقط

- كلما وضعت (*) في اول العمود C1 يلون العمود من C2 الى C50 فقط

وهكذا الى غاية العمود AE

يمكن ألا يلون عمود من هذه الاعمدة اذا لم اضع النجمة في اوله.

وشكرا وسامحني على تعبك

**عادل حنفي** · نوفمبر 9, 2009

السلام عليكم

اخي abusarah73

مشكور اخي علي كلماتك

اخي aitlahbib

شوف الملف المرفق و اخبرني النتيجه

والكود المستخدم هو


Private Sub Worksheet_Selectionchange(ByVal Target As Range)

If Target.Column > 31 Then Exit Sub

Application.ScreenUpdating = False

x = Target.Column


If Cells(1, x).Value = "*" Then

GoTo 1

Else

GoTo 2

End If

1:

m = Cells(2, x).Address

n = Cells(50, x).Address

Application.ScreenUpdating = False

Range(m, n).Interior.ColorIndex = 4

Application.ScreenUpdating = True

Exit Sub

2:

m = Cells(2, x).Address

n = Cells(50, x).Address

Application.ScreenUpdating = False

Range(m, n).Interior.ColorIndex = xlNone

Application.ScreenUpdating = True

End Sub

تحياتي

column color.rar

تم تعديل نوفمبر 9, 2009 بواسطه aah_aah2008

تسجيل الدخول

تعديل على كود تلوين الخلية المتساوية مع أخرى من نفس العمود

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

أبوســـارة1973

أبوســـارة1973

عبدالله باقشير

أبوســـارة1973

عادل حنفي

عبدالله باقشير

ايت الحبيب

ايت الحبيب

عادل حنفي

ايت الحبيب

عادل حنفي

أبوســـارة1973

ايت الحبيب

عادل حنفي

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information