Страницы: 1
RSS
Как при удалении данных из ячейки вернуть её первоначальный цвет, изменённый макросом
 

Здравствуйте, уважаемые форумчане!

Ситуация следующая: успешно пользуюсь макросом, написанным камрадом БМВ, недавно в его код для расширения функционала добавил пару строк из другого макроса

Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
      With Target
      .FormatConditions.Add Type:=xlExpression, Formula1:=True
      .FormatConditions(1).Interior.Color = RGB (245. 245. 245)
      End With
End Sub

Не уверен, всё ли я правильно сделал с точки зрения орфографии VBA, но макрос работает нормально - теперь при выделении ячейки в диапазоне К:АО в ней появляется число и изменяется её цвет.

Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then    
    If IsEmpty(Target) And Not IsEmpty(Cells(Target.Row, 9)) Then Target.Value = Cells(Target.Row, "I").Value        
        With Target        
        .FormatConditions.Add Type:=xlExpression, Formula1:=True        
        .FormatConditions(1).Interior.Color = RGB (245. 245. 245)        
        End With    
    End If
End Sub

Иногда необходимо удалить данные из некоторых ячеек вышеназванного диапазона, так вот, проблема заключается в том, что при "очищении" ячейки её цвет не становится прежним (((

В макросе, изменяющем цвет ячейки, выражение "Cells.FormatConditions.Delete" возвращает ячейке прежнее форматирование при выделении другой ячейки, однако, все мои попытки "прикрутить" его к "своему" макросу остались безуспешными ...

Просьба, уважаемые знатоки VBA, прописать в макросе дополнительное условие, при котором ячейке возвращался бы её первоначальный цвет при удалении из неё данных.

Заранее благодарен.

Изменено: samass - 27.02.2020 19:35:18
 
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then
    Target.FormatConditions.Delete
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then
    Application.EnableEvents = False
    If IsEmpty(Target) And Not IsEmpty(Cells(Target.Row, 9)) Then Target.Value = Cells(Target.Row, "I").Value
        With Target
        .FormatConditions.Add Type:=xlExpression, Formula1:=True
        .FormatConditions(1).Interior.Color = RGB(245, 245, 245)
        End With
    Application.EnableEvents = True
    
    End If
End Sub
По вопросам из тем форума, личку не читаю.
 
БМВ, всё отлично работает, Вы меня опять здорово выручили, это - как раз то, что мне нужно.
Премного благодарен, всех благ!!!
 
Только зачем условное форматирование? Почему не просто формат ячейки?
По вопросам из тем форума, личку не читаю.
 
А чтобы тормозило )
 
Цитата
БМВ написал:
Только зачем условное форматирование ...
Если честно, в программировании я полный "ноль", увидел макрос, подходящий для моих задач, подставил, заработало ...
Цитата
БМВ написал:
Почему не просто формат ячейки?
Если есть более "изящное" решение моей задачи, буду признателен.
 
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then _
    Target.Interior.Color = RGB(255, 255, 255)
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then
    If IsEmpty(Target) And Not IsEmpty(Cells(Target.Row, 9)) Then
        Application.EnableEvents = False
        With Target
            .Value = Cells(.Row, "I").Value
            .Interior.Color = RGB(245, 245, 245)
        End With
    Application.EnableEvents = True
    End If
End If
End Sub
По вопросам из тем форума, личку не читаю.
 
БМВ, ещё раз огромное спасибо за участие! Не перестаю восхищаться Вашей работой, для меня это - что-то вроде МАГИИ ...
Успеха Вам во всём и всяческих ништяков!!!
Страницы: 1
Наверх