vba условное форматирование с Worksheet_SelectionChange

Question

Я пытаюсь условно форматировать ячейки в диапазоне с помощью VBA. Моя цель заключается в том, что каждый раз, когда ячейка выбрана, каждая ячейка, содержащая тот же текст, будет отформатирована.

Мой код:

Private Sub Worksheet_SelectionChange(ByVal t As Range)  
    Cells.FormatConditions.Delete 
    Range("B2:K29").Select 
    Selection.FormatConditions.Add Type:=xlTextString, String:=t.Value, _ 
    TextOperator:=xlContains 
    With Selection.FormatConditions(1).Font 
    .Bold = True 
    .Italic = False 
    .TintAndShade = 0 
    End With 
End Sub 

Проблема в том, что каждый раз, когда я выбираю ячейку, все ячейки в диапазоне отформатированы (а не только те, которые имеют один и тот же текст, как в выбранном клетка).

Answer 1

Это работает для меня:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Dim c As Range 

    Set c = Target.Cells(1) 
    Me.Cells.FormatConditions.Delete 

    If Len(c.Value) > 0 Then 

    With Me.Range("B2:K29").FormatConditions.Add(Type:=xlTextString, _ 
         String:=c.Value, TextOperator:=xlContains) 
     With .Font 
      .Bold = True 
      .Italic = False 
      .TintAndShade = 0 
     End With 
    End With 
    End If 
End Sub 

Answer 2

То, что вы хотите сделать, это уже предусмотрено Tim так выбрать свой ответ.
Я просто отправлю это как еще один подход для всех, кто может споткнуться в этом вопросе.

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    On Error GoTo halt 
    Application.EnableEvents = False 
    Me.Cells.FormatConditions.Delete 
    If Target.Cells.Count = 1 And Not IsEmpty(Target) Then 
     With Me.Range("A1").FormatConditions.Add(Type:=xlTextString, _ 
        String:=Target.Value, TextOperator:=xlContains) 
      With .Font 
       .Bold = True 
       .Italic = False 
       .TintAndShade = 0 
      End With 
      .ModifyAppliesToRange Me.Range("B2:K29") 
     End With 
    End If 
forward: 
    Application.EnableEvents = True 
    Exit Sub 
halt: 
    MsgBox Err.Description 
    Resume forward 
End Sub