تنسيق شرطي رجاءا

[طارق نادر]

السلام عليكم ارفق ملف اريد عمل في الصفحة تنسيق شرطي بحيث اذا كتبت اي كلمة في اي من الاعمدة المعنية يتلون الصف الذي فيه الحدث الى اللون الرمادي والاعمة التي اريد عمل الحدث فيها هي من k ,ولغاية q اي سبعة اعمدة

Book1.rar

[طارق نادر]

للرفع

[سليم حاصبيا]

لا أعلم اذا كان هذا ما تريد

 

Book1 Salim.rar

[طارق نادر]

اشكرك اخي الكريم ولكن اريد ان يتضلل الصف باكمله من العمود الثاني ولا اريد الخلية الخضراء التي ترافق التلوين وان يكون لون الصف الرمادي ثابت وغير متحرك مع الخلية النشطة اي كل صف ينطبق عليه شروط التضليل يبقى مضللا

تم تعديل أبريل 28, 2017 بواسطه n_tareq

[سليم حاصبيا]

3 ساعات مضت, n_tareq said:

اشكرك اخي الكريم ولكن اريد ان يتضلل الصف باكمله من العمود الثاني ولا اريد الخلية الخضراء التي ترافق التلوين وان يكون لون الصف الرمادي ثابت وغير متحرك مع الخلية النشطة اي كل صف ينطبق عليه شروط التضليل يبقى مضللا

استبدل الماكرو بهذا

Private Sub Worksheet_Change(ByVal Target As Range)
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
         End With
Dim My_Rg As Range
Dim x, y, k, c As Long

Set My_Rg = Range("a1").CurrentRegion
On Error GoTo Exit_Sub

x = My_Rg.Rows.Count
y = My_Rg.Columns.Count
My_Rg.Interior.ColorIndex = xlNo

Set My_Rg = My_Rg.Offset(1).Resize(x - 1).Offset(, y - 7).Resize(, y - 10)

    If Not Intersect(Target, My_Rg) Is Nothing And Target.Cells.Count = 1 Then
         For k = 1 To x
           c = Application.CountA(My_Rg.Cells(k, 1).Resize(, y - 10))
           If c > 0 Then Cells(k + 1, 2).Resize(1, 16).Interior.Color = 12900829
        Next
     End If
     
Exit_Sub:
  With Application
        .ScreenUpdating = True
        .EnableEvents = True
  End With

End Sub

 

[طارق نادر]

كل الشكر والتقدير لك