Загрузка данных


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