=ЕСЛИОШИБКА(ПРОСМОТР(1;1/((СУММЕСЛИ($K$2:K2;$K$2:K2;$J$2:J2)+J3<=СУММЕСЛИ($N$2:$N$4;$K$2:K2;$O$2:$O$4)));$K$2:K2);МИН(ЕСЛИ($N$2:$N$4>МАКС($K$2:K2);$N$2:$N$4;9^9)))

Sub dd()
    Dim ar As Range, cell As Range, s%
    With Application: .ScreenUpdating = 0: .EnableEvents = 0:  End With
    With Cells(Rows.Count, 2).End(xlUp)
        With .Offset(4 - .Row).Resize(.Row - 4)
            If MsgBox("Очистить заполненные ячейки?", 36) = 6 Then _
                .Offset(, 3).ClearContents
            On Error Resume Next
            .Replace "Выплата", "=ZZ1"
            For Each ar In [ZZ1].Dependents.Areas
                For Each cell In ar.Cells
                    With cell
                        .Offset(, 3).Value = "-"
                        [F2].Formula = Join(Array("=SUMPRODUCT(D4:D", ",F4:F", _
                            "*ISBLANK(E4:E", ")*ISTEXT(B4:B", ")*(COUNTIFS($D$4:$D$", _
                            ",$D$4:$D$", ",$E$4:$E$", ","""",$C$4:$C$", ",""<""&C4:C", ")=0))-" & _
                            .Offset(0, 2).Value), .Row - 1)
                        [G2].Formula = "=$F$2=0"
                        [G3].Formula = "=COUNT($F$4:$F$" & .Row - 1 & ")"
                        [G4].FormulaArray = "=$F$4:$F$" & .Row - 1 & "=INT($F$4:$F$" & .Row - 1 & ")"
                        [G5].FormulaArray = "=$F$4:$F$" & .Row - 1 & "<=1"
                        [G6].FormulaArray = "=$F$4:$F$" & .Row - 1 & ">=0"
                        Solver.SolverLoad [G2:G6], False
                        SolverOk "$F$2", 3, 0, "$F$4:$F$" & .Row - 1, 2, "Simplex LP"
                        Select Case Solver.SolverSolve(True)
                            Case 0, 14
                    [F:F].Replace 1, "=ZZ2", xlWhole
                    [F2,G2:G6].ClearContents
                    Intersect([E:E], [ZZ2].Dependents.EntireRow).Value = .Offset(, 1)
                        End Select
                        .Value = "Выплата"
                    End With
            Next cell, ar
            .Offset(, 3).SpecialCells(4).Value = "Не выплачено"
            .Offset(-2, 4).Resize(.Count + 2, 2).ClearContents
        End With
    End With
    With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With
End Sub