رنگ بندی خودکار

[ali.b]

سلام دوستان عزیز

من 5 تا سلول دارم به فرض a1 و b1 و c1 و d1 و e1

به یک کدی نیاز دارم که وقتی روی هر سلول کلیک کرد رنگش تغییر کنه و بقیه سلول ها بی رنگ بشن
مثل سلول a1 کلیک کردم فرض رنگش زرد بشه و بقیه بی رنگ باشن
حالا وقتی روی b1 کلیک کرد بقیه رنگشون سفید باشه و تنها b1 تغییر کنه
کلا میخوام برای هر ردیف این جالت باشه و فقط هم بین این 5 تا سلول ها

ممنونم

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

در فایل پیوست با انتخاب هر یک از سلولهای A1:E1 به یک رنگ مشخص تغییر مینماید

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Then GoTo 0


    If Not Intersect(Target, Me.Range("A1:E1")) Is Nothing Then
    

If Target.Address = "$A$1" Then

Range("A1").Interior.ColorIndex = 3

Range("B1:E1").Interior.ColorIndex = 0


ElseIf Target.Address = "$B$1" Then

Range("B1").Interior.ColorIndex = 4

Range("A1").Interior.ColorIndex = 0

Range("C1:E1").Interior.ColorIndex = 0


ElseIf Target.Address = "$C$1" Then

Range("C1").Interior.ColorIndex = 5

Range("A1:B1").Interior.ColorIndex = 0

Range("E1").Interior.ColorIndex = 0


ElseIf Target.Address = "$D$1" Then

Range("D1").Interior.ColorIndex = 6

Range("A1:C1").Interior.ColorIndex = 0

Range("E1").Interior.ColorIndex = 0


ElseIf Target.Address = "$E$1" Then

Range("E1").Interior.ColorIndex = 7

Range("A1:D1").Interior.ColorIndex = 0

End If
   
   End If
   
0

End Sub 

[amir_ts]

با سلام
این روش رو هم ملاحظه کنید.

   
Private Sub Worksheet_selectionChange(ByVal Target As Range)
     Range("a1:e1").Interior.ColorIndex = 6
        
      If Not Application.Intersect(Target, Cells(1, 1)) Is Nothing Then
      Range("B1:e1").ClearFormats
      Target.Interior.ColorIndex = 6
        End If


       If Not Application.Intersect(Target, Cells(1, 2)) Is Nothing Then
       Range("A1", Range("c1:e1")).ClearFormats
       Target.Interior.ColorIndex = 6
       
          End If


      If Not Application.Intersect(Target, Cells(1, 3)) Is Nothing Then
      Range("a1:b1", Range("d1:e1")).ClearFormats
      Target.Interior.ColorIndex = 6
      End If


      If Not Application.Intersect(Target, Cells(1, 4)) Is Nothing Then
      Range("a1:c1", Range("e1")).ClearFormats
      Target.Interior.ColorIndex = 6
      End If


     If Not Application.Intersect(Target, Cells(1, 5)) Is Nothing Then
      Range("a1:d1").ClearFormats
      Target.Interior.ColorIndex = 6
      End If


End Sub
   
   

[ali.b]

ممنونم دوست عزیز
اما مشکلی که هست وقتی برای ادامه به ردیف های بعدی میرم ردیف قبلی همه زرد میشن

من مثلامیخوام فقط برای 5 ردیف و ازستوان a تاe این حالت وجود داشته باشه
ممنونم

[Ali Parsaei]

سلام، ببينيد اينجوري منظورتون است:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row >= 1 And Target.Row <= 5 Then
If Target.Column >= 1 And Target.Column <= 5 Then
Range("A1:E5").Interior.ColorIndex = 0
Cells(Target.Row, 1).Interior.ColorIndex = 6
Cells(Target.Row, 2).Interior.ColorIndex = 6
Cells(Target.Row, 3).Interior.ColorIndex = 6
Cells(Target.Row, 4).Interior.ColorIndex = 6
Cells(Target.Row, 5).Interior.ColorIndex = 6
Target.Interior.ColorIndex = 0
End If
End If
End Sub 

يا اين يکي:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row >= 1 And Target.Row <= 5 Then
If Target.Column >= 1 And Target.Column <= 5 Then
Cells(Target.Row, 1).Interior.ColorIndex = 6
Cells(Target.Row, 2).Interior.ColorIndex = 6
Cells(Target.Row, 3).Interior.ColorIndex = 6
Cells(Target.Row, 4).Interior.ColorIndex = 6
Cells(Target.Row, 5).Interior.ColorIndex = 6
Target.Interior.ColorIndex = 0
End If
End If
End Sub 

[amir_ts]

با سلام
این فایل نمونه رو هم ببینید فکر کنم با کد های ارسالی دوستان تمام شرایط ممکن بدست امده باشه.

[ali.b]

با سلام
این فایل نمونه رو هم ببینید فکر کنم با کد های ارسالی دوستان تمام شرایط ممکن بدست امده باشه.

این فایل و کد دوستمون پارسا کارمو راه انداخت
حالا اگه فرضا ی وقت بخوام برای هر ردیف بشه یعنی از محدوده a1 تا e1 همین روش

برای a2 تا e2 هم همین
یعنی برای هر ردیف فقط بشه یکی رو انتخاب کرد چطور کداش تغییر می کنن؟

[amir_ts]

این فایل رو هم ببینید. امیدوارم منظور شما رو درست متوجه شده باشم.

Private Sub Worksheet_selectionChange(ByVal Target As Range)
Range("A1:E5").Interior.ColorIndex = 6

If Intersect(Target, Range("A1:E5")) Is Nothing Then Exit Sub

 Select Case Target.Row
 Case Is = 1
  Range("A2:E5").ClearFormats
  Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Interior.ColorIndex = 6

 Case Is = 2
  Range("A1:E1", Range("A3:E5")).ClearFormats
 
 Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Interior.ColorIndex = 6
 
 Case Is = 3
  Range("A1:E2", Range("A4:E5")).ClearFormats
 Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Interior.ColorIndex = 6
  
Case Is = 4
  Range("A1:E3", Range("A5:E5")).ClearFormats
 Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Interior.ColorIndex = 6
 
 Case Is = 5
  Range("A1:E4").ClearFormats
 Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Interior.ColorIndex = 6
 
  End Select
 
End Sub