---

Option Explicit

' ==============================================================================
' 1. АВТОМАТИЧЕСКИЙ ТРИГГЕР
' ==============================================================================
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngToWatch As Range
    ' Отслеживаем изменения в диапазоне от P (16) до CM (91)
    Set rngToWatch = Intersect(Target, Me.Columns("P:CM"))
    
    If Not rngToWatch Is Nothing Then
        Dim rw As Range
        Dim rowNum As Long
        Dim rowsProcessed As Object
        Set rowsProcessed = CreateObject("Scripting.Dictionary")
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        On Error GoTo SafeExit
        
        For Each rw In rngToWatch.Rows
            rowNum = rw.Row
            If rowNum >= 4 And Not rowsProcessed.exists(rowNum) Then
                rowsProcessed.Add rowNum, True
                Call ProcessRowColoring(Me, rowNum)
            End If
        Next rw
        
SafeExit:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
        If Err.Number <> 0 Then
            MsgBox "Ошибка: " & Err.Description, vbCritical
        End If
    End If
End Sub

' ==============================================================================
' 2. МАКРОС ДЛЯ РУЧНОГО ЗАПУСКА
' ==============================================================================
Sub ColorAllDeficits()
    Dim lastRow As Long
    Dim r As Long
    
    lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    If lastRow < 4 Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo SafeExit
    
    For r = 4 To lastRow
        Call ProcessRowColoring(Me, r)
    Next r
    
SafeExit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    If Err.Number <> 0 Then
        MsgBox "Ошибка: " & Err.Description, vbCritical
        Exit Sub
    End If
    
    MsgBox "Раскраска завершена!", vbInformation, "Готово"
End Sub

' ==============================================================================
' 3. ОСНОВНАЯ ЛОГИКА РАСКРАСКИ
' ==============================================================================
Private Sub ProcessRowColoring(ws As Worksheet, r As Long)
    Dim valCK As Variant
    Dim valCL As Variant
    Dim valCM As Variant
    Dim defNum As Long
    Dim yellowNum As Long
    Dim blueNum As Long
    Dim countColored As Long
    Dim c As Long
    
    Dim colP As Long: colP = 16
    Dim colCB As Long: colCB = 80
    Dim colCK As Long: colCK = 89
    Dim colCL As Long: colCL = 90
    Dim colCM As Long: colCM = 91
    
    ' Сбрасываем всю старую раскраску в строке перед началом работы
    ws.Range(ws.Cells(r, colP), ws.Cells(r, colCK)).Interior.ColorIndex = xlNone
    
    ' ПРАВИЛО-ИСКЛЮЧЕНИЕ: Все пустые ячейки красим в зеленый ТОЛЬКО в диапазоне P:CB
    For c = colP To colCB
        If IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "" Then
            ws.Cells(r, c).Interior.Color = RGB(146, 208, 80) ' Зеленый цвет
        End If
    Next c
    
    valCK = ws.Cells(r, colCK).Value
    valCL = ws.Cells(r, colCL).Value
    valCM = ws.Cells(r, colCM).Value
    
    ' Проверяем валидность значения в CL
    yellowNum = 0
    If Not IsEmpty(valCL) And Not IsError(valCL) Then
        If IsNumeric(valCL) Then
            If valCL > 0 Then
                ' Округление в меньшую сторону
                yellowNum = Int(valCL)
            End If
        End If
    End If
    
    ' Проверяем валидность значения в CM (синий цвет)
    blueNum = 0
    If Not IsEmpty(valCM) And Not IsError(valCM) Then
        If IsNumeric(valCM) Then
            If valCM > 0 Then
                ' Округление в меньшую сторону
                blueNum = Int(valCM)
            End If
        End If
    End If
    
    ' Если в CK ошибка или пусто — прерываем окраску
    If IsError(valCK) Then Exit Sub
    If IsEmpty(valCK) Or Trim(CStr(valCK)) = "" Then Exit Sub
    
    ' Если в CK число
    If IsNumeric(valCK) Then
        
        ' --- СЦЕНАРИЙ А: Дефицит >= 0 - вся строка зеленая (кроме желтых и синих) ---
        If valCK >= 0 Then
            countColored = 0
            
            ' Сначала красим желтым (если есть)
            If yellowNum > 0 Then
                For c = colCB To colP Step -1
                    If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
                        If countColored < yellowNum Then
                            ws.Cells(r, c).Interior.Color = RGB(255, 255, 0) ' Желтый
                            countColored = countColored + 1
                        Else
                            ws.Cells(r, c).Interior.Color = RGB(146, 208, 80) ' Зеленый
                        End If
                    End If
                Next c
            Else
                ' Если нет желтых - все зеленые
                For c = colP To colCB
                    If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
                        ws.Cells(r, c).Interior.Color = RGB(146, 208, 80) ' Зеленый
                    End If
                Next c
            End If
            
        ' --- СЦЕНАРИЙ Б: Отрицательный дефицит ---
        ElseIf valCK < 0 Then
            ' Округление в меньшую сторону и модуль
            defNum = Abs(Int(valCK))
            
            ' Определяем сколько красных и желтых нужно
            Dim redNum As Long
            redNum = defNum - yellowNum
            If redNum < 0 Then redNum = 0
            
            ' Красим справа налево: сначала красные, потом желтые, потом зеленые
            countColored = 0
            Dim redColored As Long
            Dim yellowColored As Long
            
            redColored = 0
            yellowColored = 0
            
            For c = colCB To colP Step -1
                If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
                    If redColored < redNum Then
                        ' Красим красным (самые правые)
                        ws.Cells(r, c).Interior.Color = RGB(255, 100, 100) ' Красный
                        redColored = redColored + 1
                    ElseIf yellowColored < yellowNum Then
                        ' Красим желтым (после красных)
                        ws.Cells(r, c).Interior.Color = RGB(255, 255, 0) ' Желтый
                        yellowColored = yellowColored + 1
                    Else
                        ' Остальные зеленые
                        ws.Cells(r, c).Interior.Color = RGB(146, 208, 80) ' Зеленый
                    End If
                End If
            Next c
        End If
        
    End If
    
    ' ==============================================================================
    ' ФИНАЛЬНЫЙ ЭТАП: РАСКРАСКА СИНИМ ЦВЕТОМ (ПОВЕРХ СУЩЕСТВУЮЩИХ)
    ' ==============================================================================
    If blueNum > 0 Then
        Call ApplyBlueColoring(ws, r, blueNum, colP, colCB)
    End If
End Sub

' ==============================================================================
' 4. ФУНКЦИЯ ДЛЯ ПРИМЕНЕНИЯ СИНЕГО ЦВЕТА
' ==============================================================================
Private Sub ApplyBlueColoring(ws As Worksheet, r As Long, blueNum As Long, colP As Long, colCB As Long)
    Dim c As Long
    Dim blueColored As Long
    Dim currentColor As Long
    
    blueColored = 0
    
    ' Проходим слева направо, ищем желтые и красные ячейки
    For c = colP To colCB
        If blueColored >= blueNum Then Exit For
        
        If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
            currentColor = ws.Cells(r, c).Interior.Color
            
            ' Закрашиваем синим поверх желтого (слева от желтых)
            If currentColor = RGB(255, 255, 0) Then ' Желтый
                ws.Cells(r, c).Interior.Color = RGB(0, 112, 192) ' Синий
                blueColored = blueColored + 1
            End If
        End If
    Next c
    
    ' Если еще остались синие, закрашиваем поверх красных (слева от красных)
    If blueColored < blueNum Then
        For c = colP To colCB
            If blueColored >= blueNum Then Exit For
            
            If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
                currentColor = ws.Cells(r, c).Interior.Color
                
                ' Закрашиваем синим поверх красного
                If currentColor = RGB(255, 100, 100) Then ' Красный
                    ws.Cells(r, c).Interior.Color = RGB(0, 112, 192) ' Синий
                    blueColored = blueColored + 1
                End If
            End If
        Next c
    End If
    
    ' Если еще остались синие и нет желтых/красных, закрашиваем зеленые справа
    If blueColored < blueNum Then
        For c = colCB To colP Step -1
            If blueColored >= blueNum Then Exit For
            
            If Not (IsEmpty(ws.Cells(r, c)) Or Trim(CStr(ws.Cells(r, c).Value)) = "") Then
                currentColor = ws.Cells(r, c).Interior.Color
                
                ' Закрашиваем синим поверх зеленого (справа налево)
                If currentColor = RGB(146, 208, 80) Then ' Зеленый
                    ws.Cells(r, c).Interior.Color = RGB(0, 112, 192) ' Синий
                    blueColored = blueColored + 1
                End If
            End If
        Next c
    End If
End Sub