Условное форматирование заголовка таблицы по содержанию строки
Пользователь
Сообщений: Регистрация: 01.01.1970
15.04.2014 12:47:10
Уважаемые знатоки Экселя. Мне нужна ваша помощь. Я столкнулся с такой задачей: В первом столбце таблицы ставится маркер. В моём случае это латинская буква "а". Благодаря скрипту, найденному на данном сайте она ставится простым кликом по ячейке. Далее в таблице в заголовке идёт список фамилий. Под ними указывается отработанное время простым числом и иногда буками. Мне нужно условное форматирование для заголовка с фамилиями, чтобы подсвечивались ячейки заполненные в строке, в которой стоит маркер "а" и под которыми заполнено время. То есть, поставив маркер в определённой строке я хочу сразу видеть подсветку, какие люди работали. Подробные разъяснения в прикреплённом файле. Буду крайне признателен за помощь.
Выражаю свою благодарность пользователям и за помощь в решении вопроса. Совместив их варианты я получил то, что мне нужно. Ниже опишу все подробности.
Формула условного форматирования от отлично работает и в реальном времени отслеживает изменение содержания таблицы. Поэтому для условного форматирования я выбрал её. Скрипт от также умеет выполнять условное форматирование, но при заполнении ячеек он не отображает текущего состояния таблицы во время её заполнения. Чтобы форматирование сработало, нужно щёлкнуть на другую строку, а затем вернуться на предыдущую, но доработал скрипт для выделения строки макросом. Постановка маркера в первой ячейке: можно клацать в любом месте таблицы. Это очень удобно именно для моего случая. Макрос с форматированием заголовка таблицы:
Скрытый текст
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim str As String
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
str = Target.Value
Application.EnableEvents = False
r = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:A" & r).ClearContents
Target.Value = str
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange
(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 23 Then Exit Sub
If Target.Row <= 2 Then Exit Sub
If Not Intersect(Target, Range("A2:W100")) Is Nothing Then
Cells(Target.Row, 1).Font.Name = "Marlett"
If Cells(Target.Row, 1) = vbNullString Then
Cells(Target.Row, 1) = "a"
For i = 4 To Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If Cells(Target.Row, i) <> "" Then
If Cells(2, i) = "ВСЕГО:" Then Exit For
Cells(2, i).Interior.Color = RGB(0, 100, 0)
Else
Cells(2, i).Interior.Pattern = xlNone
End If
Next
Else
Cells(Target.Row, 1) = vbNullString
End If
End If
End Sub
Private Sub Worksheet_BeforeDoubleCli
ck(ByVal Target As Range, Cancel As Boolean)
If Target.Row > 2 Then Exit Sub
If Not Intersect(Target, Range("A2:W100")) Is Nothing Then
Cancel = True
Cells(Target.Row, 1).Font.Name = "Marlett"
If Cells(Target.Row, 1) = vbNullString Then
Cells(Target.Row, 1) = "a"
Else
Cells(Target.Row, 1) = vbNullString
End If
End If
End Sub
Далее код, который не выполняет форматирование заголовка таблицы, а лишь ставит галочку в первый столбец активной строки по клику в любом месте таблицы:
Скрытый текст
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim str As String
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
str = Target.Value
Application.EnableEvents = False
r = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:A" & r).ClearContents
Target.Value = str
End If
Application.EnableEvents = True
End Sub
'CODE 1 Ставим флажок, если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 23 Then Exit Sub
If Target.Row <= 2 Then Exit Sub
If Not Intersect(Target, Range("A2:W100")) Is Nothing Then
Cells(Target.Row, 1).Font.Name = "Marlett"
If Cells(Target.Row, 1) = vbNullString Then
Cells(Target.Row, 1) = "a"
For i = 4 To Cells(Target.Row, Columns.Count).End(xlToLeft).Column
Next
Else
Cells(Target.Row, 1) = vbNullString
End If
End If
End Sub
'CODE 2 Снимаем флажок, если был двойной щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row > 2 Then Exit Sub
If Not Intersect(Target, Range("A2:W100")) Is Nothing Then
Cancel = True
Cells(Target.Row, 1).Font.Name = "Marlett"
If Cells(Target.Row, 1) = vbNullString Then
Cells(Target.Row, 1) = "a"
Else
Cells(Target.Row, 1) = vbNullString
End If
End If
End Sub
Прикреплённый файл - это результат моего объединения двух методов, скрипта для постановки маркера и условного форматирования.
НЕДОСТАТОК: при работе с одной строкой выделение поочерёдно будет появляться и исчезать. Если у кого-то есть возможность подправить макрос, чтобы при кликах по одной строке маркер не снимался, буду очень признателен. Прошу знающих людей проверить, всё ли я правильно написал, так как мои познания EXCEL очень ограничены.
