=СУММЕСЛИМН(График!$C$67:$C$86;График!$B$67:$B$86;График!$B:$B)>СУММЕСЛИМН(График!$C$5:$C$64;График!$B$5:$B$64;График!$B:$B)

=СУММЕСЛИМН(Хозяйства!E:E;Хозяйства!D:D;Хозяйства!D:D)>СУММЕСЛИМН(График!C:C;График!B:B;Хозяйства!D:D)

Option Explicit

Sub Сумма_заказов()
    Sheet_job 2, "+", "", ""
End Sub

Sub Среднее_заказов()
    Sheet_job 3, ",", "AVERAGE(", ")"
End Sub

Private Sub Sheet_job(xPrint As Long, prefix1 As String, prefix2 As String, postfix3 As String)
    Dim cd As Range, vv As Variant, dic As Object, arr As Variant, ya As Long, ss As Variant
    Set dic = CreateObject("Scripting.Dictionary")
    arr = ActiveSheet.UsedRange.Columns("A:A").Value
    For ya = 1 To UBound(arr, 1)
        If Not IsEmpty(arr(ya, 1)) Then
            dic(arr(ya, 1)) = dic(arr(ya, 1)) & prefix1 & "B" & ya
        End If
    Next
    
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual

    For Each cd In ActiveSheet.UsedRange.Columns("D:D").Cells
        If Not IsEmpty(cd.Value) Then
            ss = ""
            For Each vv In Split(cd.Value, ";")
                If dic.Exists(Trim(vv)) Then
                    ss = ss & dic(Trim(vv))
                End If
            Next
            If ss = "" Then
                ss = Empty
            Else
                ss = Mid(ss, 2, Len(ss) - 1)
                ss = prefix2 & ss & postfix3
                ss = "=" & ss
            End If
            cd.Cells(1, xPrint).Formula = ss
        End If
    Next
    Application.Calculation = Application_Calculation
End Sub

=(СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));0*2*ДЛСТР(D1)+1;2*ДЛСТР(D1))))
+СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));1*2*ДЛСТР(D1)+1;2*ДЛСТР(D1))))
+СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));2*2*ДЛСТР(D1)+1;2*ДЛСТР(D1)))))
/((ДЛСТР(D1)-ДЛСТР(ПОДСТАВИТЬ(D1;"; ";"")))/ДЛСТР("; ")+1)

=СУММ(M1:XFD1)/СЧЁТЕСЛИМН(M1:XFD1;">0")

Option Explicit

Sub Сумм_заказов()
    Dim cd As Range, vv As Variant, dic As Object, arr As Variant, ya As Long, ss As Variant
    Set dic = CreateObject("Scripting.Dictionary")
    arr = ActiveSheet.UsedRange.Columns("A:A").Value
    For ya = 1 To UBound(arr, 1)
        If Not IsEmpty(arr(ya, 1)) Then
            dic(arr(ya, 1)) = dic(arr(ya, 1)) & "+B" & ya
        End If
    Next
    
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual

    For Each cd In ActiveSheet.UsedRange.Columns("D:D").Cells
        If Not IsEmpty(cd.Value) Then
            ss = ""
            For Each vv In Split(cd.Value, ";")
                If dic.Exists(Trim(vv)) Then
                    ss = ss & dic(Trim(vv))
                End If
            Next
            If ss = "" Then
                ss = Empty
            Else
                ss = Mid(ss, 2, Len(ss) - 1)
                ss = "=" & ss
            End If
            cd.Cells(1, 2).Formula = ss
        End If
    Next
    Application.Calculation = Application_Calculation
End Sub

=СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));0*2*ДЛСТР(D1)+1;2*ДЛСТР(D1))))
+СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));1*2*ДЛСТР(D1)+1;2*ДЛСТР(D1))))
+СУММЕСЛИМН(B:B;A:A;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(D1;";";ПОВТОР(" ";2*ДЛСТР(D1)));2*2*ДЛСТР(D1)+1;2*ДЛСТР(D1))))

=ИНДЕКС(Лист2!A2:A6;ПОИСКПОЗ(A3;Лист2!A1:A5;0))

If iStart > 0 And iEnd > 0 Then
        .HTMLBody = Left(.HTMLBody, iStart - 1) & YourHTMLBody & Mid(.HTMLBody, iEnd)
else
        .HTMLBody =YourHTMLBody 
End If

=(ПРАВСИМВ(ЯЧЕЙКА("формат";B2);2)<>",1")*(ЯЧЕЙКА("формат";B2)<>"P0")*ЕЧИСЛО(B2)

Option Explicit
'v2
Sub Find_in_file()
    Find_in_workbook ActiveWorkbook
End Sub

Sub Find_in_workbook(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        Find_in_sheet sh
    Next
End Sub

Sub Find_in_sheet(sh As Worksheet)
    Dim ur As Range
    On Error Resume Next
    Set ur = sh.UsedRange
    On Error GoTo 0
    If ur Is Nothing Then Exit Sub
    
    Find_in_range ur
End Sub

Sub Find_in_range(rr As Range)
    Dim cl As Range
    For Each cl In rr.Cells
        Find_in_cell cl
    Next
End Sub

Sub Find_in_cell(cl As Range)
    If IsError(cl.Value) Then Exit Sub
    If IsEmpty(cl.Value) Then Exit Sub
    If Not IsNumeric(cl.Value) Then Exit Sub
    Select Case cl.NumberFormat
    Case "#,##0.0,,", "0%"
    Case Else
        cl.Interior.Color = RGB(255, 200, 200)
    End Select
End Sub

Option Explicit

Sub Find_in_file()
    Find_in_workbook ActiveWorkbook
End Sub

Sub Find_in_workbook(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        Find_in_sheet sh
    Next
End Sub

Sub Find_in_sheet(sh As Worksheet)
    Dim ur As Range
    On Error Resume Next
    Set ur = sh.UsedRange
    On Error GoTo 0
    If ur Is Nothing Then Exit Sub
    
    Find_in_range ur
End Sub

Sub Find_in_range(rr As Range)
    Dim cl As Range
    For Each cl In rr.Cells
        Find_in_cell cl
    Next
End Sub

Sub Find_in_cell(cl As Range)
    If IsError(cl.Value) Then Exit Sub
    If IsEmpty(cl.Value) Then Exit Sub
    If Not IsNumeric(cl.Value) Then Exit Sub
    If cl.NumberFormat <> "#,##0.0,," Then
        cl.Interior.Color = RGB(255, 200, 200)
    End If
End Sub

Option Explicit

Sub Move_colors()
    Move_lines_job ActiveSheet
End Sub

Private Sub Move_lines_job(shSource As Worksheet)
    CloseEmptyWb
    shSource.Copy
    
    Dim FIO As Range
    Set FIO = ActiveSheet.UsedRange.Find("Ф.И.О.").Cells(1, 1)
    
    Dim dic As Object
    Set dic = GetDicColor(FIO)
    
    Dim vColor As Variant
    For Each vColor In dic.Keys()
        Move_one CStr(vColor), dic(vColor), FIO
    Next
End Sub

Private Sub Move_one(sheetName As String, sampleAddress As String, FIO As Range)
    FIO.Parent.Copy After:=FIO.Parent
    ActiveSheet.Name = sheetName
    
    Dim yu As Long, xu As Long, keepRow As Boolean
    Dim curColor As Long
    curColor = Range(sampleAddress).Interior.Color
    
    For yu = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To FIO.Row + 2 Step -1
        keepRow = False
        For xu = ActiveSheet.UsedRange.Column To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
            If ActiveSheet.Cells(yu, xu).Interior.Color = curColor Then
                keepRow = True
                Exit For
            End If
        Next
        If keepRow Then
            For xu = FIO.Column To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
                Select Case ActiveSheet.Cells(yu, xu).Interior.Color
                Case RGB(255, 255, 255), curColor
                Case Else
                    With ActiveSheet.Cells(yu, xu)
                        .ClearContents
                        .Interior.Pattern = xlNone
                    End With
                End Select
            Next
        Else
            ActiveSheet.Rows(yu).EntireRow.Delete
        End If
    Next
    
    ActiveWorkbook.Saved = True
End Sub

Private Function GetDicColor(FIO As Range) As Object
    Dim sh As Worksheet
    Set sh = FIO.Parent
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim yu As Long, xu As Long
    For yu = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1 To FIO.Row + 2 Step -1
        For xu = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 To FIO.Column + 1 Step -1
            If sh.Cells(yu, xu).Interior.Color <> RGB(255, 255, 255) Then
                dic(sh.Cells(yu, xu).Interior.Color) = sh.Cells(yu, xu).Address(0, 0, xlA1)
            End If
        Next
    Next
    Set GetDicColor = dic
End Function

Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub

Option Explicit

Sub Move_lines()
    Move_lines_job ActiveSheet
End Sub
Private Sub Move_lines_job(shSource As Worksheet)
    CloseEmptyWb
    shSource.Copy
    
    Dim FIO As Range
    Set FIO = ActiveSheet.UsedRange.Find("Ф.И.О.").Cells(1, 1)
    
    Dim yu As Long, xu As Long, keepRow As Boolean
    Dim curColor As Long
    curColor = ActiveCell.Interior.Color
    
    For yu = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To FIO.Row + 2 Step -1
        keepRow = False
        For xu = ActiveSheet.UsedRange.Column To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
            If ActiveSheet.Cells(yu, xu).Interior.Color = curColor Then
                keepRow = True
                Exit For
            End If
        Next
        If keepRow Then
            For xu = FIO.Column To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
                Select Case ActiveSheet.Cells(yu, xu).Interior.Color
                Case RGB(255, 255, 255), curColor
                Case Else
                    With ActiveSheet.Cells(yu, xu)
                        .ClearContents
                        .Interior.Pattern = xlNone
                    End With
                End Select
            Next
        Else
            ActiveSheet.Rows(yu).EntireRow.Delete
        End If
    Next
    
    ActiveWorkbook.Saved = True
End Sub

Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub

=SumByColor(C4:AG4;K4)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B3:C5")) Is Nothing Then
    ElseIf Not Intersect(Target, Range("F3")) Is Nothing Then
    Else
        Exit Sub
    End If
    
    Dim cb As Range
    For Each cb In Range("B3:B5").Cells
        If cb.Value <= Range("F3") Then
            If cb.Cells(1, 2).Value >= Range("F3") Then
                Range("G3").Formula = "=" & cb.Cells(1, 3).Address(0, 0, xlA1)
                Exit For
            End If
        End If
    Next
End Sub

=(B3<=$F$3)*(C3>=$F$3)

=ВПР(1;A3:D5;4;0)

=ИНДЕКС(D1:D5;МАКС((B3:B5<=F3)*(C3:C5>=F3)*СТРОКА(B3:B5)))

Activesheet.Usedrange.Entirerow.Autofit

=(СУММ($E10:E10)>ИНДЕКС($E$1:$G$1;2*(ПОИСКПОЗ($A11;$C$1:$D$1;0)-1)+1))*(СУММ(D10:$E10)<=ИНДЕКС($E$1:$G$1;2*(ПОИСКПОЗ($A11;$C$1:$D$1;0)-1)+1))

=СЧЁТЕСЛИМН(СМЕЩ($G$12:$G$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);">="&ДАТА(2026;СТОЛБЕЦ(A:A);1);СМЕЩ($G$12:$G$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);"<"&ДАТА(2026;СТОЛБЕЦ(A:A)+1;1);$B$12:$B$18;$A24)
+СЧЁТЕСЛИМН(СМЕЩ($K$12:$K$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);">="&ДАТА(2026;СТОЛБЕЦ(A:A);1);СМЕЩ($K$12:$K$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);"<"&ДАТА(2026;СТОЛБЕЦ(A:A)+1;1);$B$12:$B$18;$A24)
+СЧЁТЕСЛИМН(СМЕЩ($O$12:$O$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);">="&ДАТА(2026;СТОЛБЕЦ(A:A);1);СМЕЩ($O$12:$O$18;0;ПОИСКПОЗ($B24;$C$11:$E$11;0)-1);"<"&ДАТА(2026;СТОЛБЕЦ(A:A)+1;1);$B$12:$B$18;$A24)

=ДАТА(ГОД(СМЕЩ($C12;0;ОСТАТ(СТОЛБЕЦ(A1)-1;4)));МЕСЯЦ(СМЕЩ($C12;0;ОСТАТ(СТОЛБЕЦ(A1)-1;4)))+СУММЕСЛИМН($D$4:$D$8;$B$4:$B$8;$B12;$C$4:$C$8;СМЕЩ($C$11;0;ОСТАТ(СТОЛБЕЦ(A1)-1;4)))*(ЦЕЛОЕ((СТОЛБЕЦ(A:A)-1)/4)+1);ДЕНЬ(СМЕЩ($C12;0;ОСТАТ(СТОЛБЕЦ(A1)-1;4))))

Sub Копировать_изменить_формулу()
    Dim cs As Range, cr As Range, sf As String, sb As String
    For Each cs In Intersect(Selection, ActiveSheet.UsedRange).Columns(1).Cells
        For Each cr In Intersect(Selection, cs.Cells(1, 2).Resize(1, Selection.Columns.Count)).Cells
            sf = cs.Formula
            sf = Replace(sf, "!" & cs.EntireColumn.Cells(2, 1).Value, "!" & cr.EntireColumn.Cells(2, 1).Value)
            On Error Resume Next
            cr.Formula = sf
            On Error GoTo 0
        Next
    Next
End Sub

Option Explicit
Private Const SOURCE_RANGE = "B2:E16"
Private Const ROWS_RANGE = "F2:F16"
Private Const TARGET_RANGE = "G2"
Private Const BLOCK_ROWS_COUNT = 3

Sub MassCopy()
    Dim cTarget As Range
    Set cTarget = Range(TARGET_RANGE)
    
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual
    
    Dim cRow As Range, step As Long
    For Each cRow In Range(ROWS_RANGE).Cells
        Range(SOURCE_RANGE).Rows(cRow.Value).Copy cTarget
        cRow.Copy cTarget.Columns(Range(SOURCE_RANGE).Columns.Count + 1)
        Set cTarget = cTarget.Cells(2, 1)
        step = step + 1
        If step = BLOCK_ROWS_COUNT Then
            step = 0
            Set cTarget = cTarget.Cells(1, Range(SOURCE_RANGE).Columns.Count + 1)
        End If
    Next
    
    Application.Calculation = Application_Calculation
End Sub

Option Explicit 'В модуле обязательно объявлять переменные. Да, да, оказывается в VBA можно не объявлять переменные.
  
Sub Таблица_поумничай()     'Название макроса
    CloseEmptyWb    'Вызов вспомогательной процедуры для закрытия "пустых" книг.
    ActiveSheet.Copy    'Копируем активный лист в новую книгу.
      
    Dim xx As Long, colName As Variant
    For xx = ActiveSheet.UsedRange.Columns.Count To ActiveSheet.UsedRange.Column Step -1    'Перебираем столбцы с последнего до первого
        For Each colName In Array("Приоритет", "Осталось на выполнение", "Категории")   'Перебираем названия столбцов для удаления
            If Cells(1, xx).Value = colName Then    'Если значение в первой строке равно названию для удаления
                Columns(xx).EntireColumn.Delete     'удаляем весь столбец
            End If
        Next
    Next
    If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(1).Delete      'Удаляем кнопку, которая скопировалась вместе с листом.
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Таблица1"   'Создаём умную таблицу.
    Dim tb As ListObject
    Set tb = ActiveSheet.ListObjects(ActiveSheet.ListObjects.Count)
    
    tb.TableStyle = "TableStyleLight13" 'Задаём стиль умной таблицы
    On Error Resume Next
    tb.ShowTotals = True    'Отображаем строку итогов.
    tb.ListColumns("Статус").TotalsCalculation = xlTotalsCalculationCount   'В строке итогов в столбце Статус ставим формулу подсчёта значений
    tb.ListColumns("Изменена").TotalsCalculation = xlTotalsCalculationNone  'В строке итогов в столбце Изменена ставим формулу подсчёта значений
    On Error GoTo 0
    tb.Range.Select 'Выделяем диапазон умной таблицы.
End Sub
  
Private Sub CloseEmptyWb() 'Вспомогательная процедура для закрытия "пустых" книг.
    Dim wb As Workbook
    For Each wb In Application.Workbooks    'Перебираем книги в приложении
        If wb.Path = "" Then wb.Close False 'Если книга не была ни разу сохранена, закрыть без сохранения.
    Next
End Sub

Option Explicit
'v2
Private Sub CommandButton1_Click()
    ActiveCell.Formula = ConnectText
End Sub

Private Function ConnectText() As String
    Dim cb As Object, ss As String, iCount As Long
    ss = "="
    For Each cb In GetControlColection("TextBox")
        iCount = iCount + 1
        If IsNumeric(cb.Value) Then
            If iCount Mod 2 = 1 Then
                ss = ss & "+ABS("
            End If
            If cb.Value >= 0 Then
                ss = ss & "+" & cb.Value
            Else
                ss = ss & cb.Value
            End If
            If iCount Mod 2 <> 1 Then
                ss = ss & ")"
            End If
        End If
    Next
    ConnectText = ss
End Function

Private Function GetControlColection(sTypeName As String) As Collection
    Dim col As New Collection
    Dim cb As Control
    For Each cb In Me.Controls
        If TypeName(cb) = sTypeName Then
            col.Add cb
        End If
    Next
    Set GetControlColection = col
End Function

=1+СУММ((2-2);(4-4);(10-10))-15