Sub HighlightMissingReasons()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long, col As Long
Dim empID As String
Dim rowDev As Long, rowReason As Long
Dim cellDev As Variant, cellReason As Variant
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
' Отключаем обновление экрана для скорости
Application.ScreenUpdating = False
' Сбрасываем старую заливку в диапазоне данных G:AK (кроме шапки)
If lastRow >= 2 Then
ws.Range(ws.Cells(2, "G"), ws.Cells(lastRow, "AK")).Interior.Color = xlNone
End If
' Перебираем строки в поиске блоков "3_отклонения"
For i = 2 To lastRow
' Проверяем, что это строка с отклонениями
If ws.Cells(i, "F").Value = "3_отклонения" Then
empID = CStr(ws.Cells(i, "E").Value)
rowDev = i
rowReason = 0
' Ищем парную строку "5_вид причины" для ЭТОГО ЖЕ сотрудника
' Обычно она идет следом, но ищем по всей таблице для надежности
For j = 2 To lastRow
If CStr(ws.Cells(j, "E").Value) = empID And ws.Cells(j, "F").Value = "5_вид причины" Then
rowReason = j
Exit For
End If
Next j
' Если пара найдена, сравниваем столбцы с G (7) по AK (37)
If rowReason > 0 Then
For col = 7 To 37 ' Столбцы от G до AK
cellDev = ws.Cells(rowDev, col).Value
cellReason = ws.Cells(rowReason, col).Value
' Условие: в отклонениях данные ЕСТЬ, а в причине — ПУСТО
If cellDev <> "" And cellReason = "" Then
' Закрашиваем ячейку в строке "3_отклонения" в светло-красный цвет
ws.Cells(rowDev, col).Interior.Color = RGB(255, 199, 206)
End If
Next col
End If
End If
Next i
Application.ScreenUpdating = True
MsgBox "Проверка завершена! Пропущенные причины подсвечены красным.", vbInformation, "Готово"
End Sub