=СЧЁТЕСЛИМН(СМЕЩ($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

=1-2+2-4+4-10+10-15

=ABS(1-2)+ABS(2-4)+ABS(4-10)+ABS(10-15)

Option Explicit
Private Const sFIND = "NC"
Private Const sPRINT = "LIBER"

Sub NC_LIBER()
    NC_LIBER_sheetJob ActiveSheet
End Sub

Private Sub NC_LIBER_sheetJob(sh As Worksheet)
    Application.ScreenUpdating = False
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual
    
    Dim nc As Range, cAfter As Range, firstAddress As String
    Do
        On Error Resume Next
        If cAfter Is Nothing Then
            Set nc = sh.UsedRange.Find(What:=sFIND)
            firstAddress = nc.Address(0, 0, xlA1)
        Else
            Set nc = sh.UsedRange.Find(What:=sFIND, After:=cAfter)
            If firstAddress = nc.Address(0, 0, xlA1) Then Exit Do
        End If
        On Error GoTo 0
        If nc Is Nothing Then Exit Do
        NC_LIBER_cellJob nc.Cells(1, 2)
        
        Set cAfter = nc
        DoEvents
    Loop
    
    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
End Sub

Private Sub NC_LIBER_cellJob(li As Range)
    If li.Value <> sPRINT Then
        li.Value = sPRINT
        li.Font.Color = RGB(255, 0, 0)
    End If
End Sub

Sub RegisterPatient()
    Range("A1:I1").Copy Cells(Rows.Count, 1).End(xlUp).Cells(2, 1)
End Sub

Public Function AC(What As String) As Variant
    Dim cf As Range
    On Error Resume Next
    Set cf = ActiveSheet.Cells.Find(What:=What, LookAt:=xlPart)
    On Error GoTo 0
    If Not cf Is Nothing Then
        AC = Intersect(ActiveCell.EntireRow, cf.EntireColumn)
    End If
End Function

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
    ActiveSheet.Shapes(1).Delete    'Удаляем кнопку, которая скопировалась вместе с листом.
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Таблица1"   'Создаём умную таблицу.
    ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight13" 'Задаём стиль умной таблицы
    ActiveSheet.ListObjects(1).ShowTotals = True    'Отображаем строку итогов.
    ActiveSheet.ListObjects(1).ListColumns("Статус").TotalsCalculation = xlTotalsCalculationCount   'В строке итогов в столбце Статус ставим формулу подсчёта значений
    ActiveSheet.ListObjects(1).ListColumns("Изменена").TotalsCalculation = xlTotalsCalculationNone  'В строке итогов в столбце Изменена ставим формулу подсчёта значений
    ActiveSheet.ListObjects(1).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

=ИНДЕКС(СМЕЩ(B12;ПОИСКПОЗ(A4;A13:A20;0);0;СЧЁТЕСЛИМН(A13:A20;A4);1);ПОИСКПОЗ(B4;СМЕЩ(B12;ПОИСКПОЗ(A4;A13:A20;0);0;СЧЁТЕСЛИМН(A13:A20;A4);1);1))

Public Sub FormToc(sh As Worksheet)
    Const skip = "Главная Содержание Результаты"
    Dim aSkip As Variant
    aSkip = Split(skip, " ")
    
    Dim nn As Long
    nn = ThisWorkbook.Worksheets.Count - (UBound(aSkip) + 1)
    nn = WorksheetFunction.RoundUp(Sqr(nn), 0)
    
    Dim arr As Variant, xa As Long, ya As Long
    ReDim arr(1 To nn, 1 To nn)
    ya = 1
    
    Dim iSh As Worksheet
    For Each iSh In ThisWorkbook.Worksheets
        If InStr(skip, iSh.Name) = 0 Then
            xa = xa + 1
            If xa > UBound(arr, 2) Then
                xa = 1
                ya = ya + 1
            End If
            arr(ya, xa) = iSh.Name
        End If
    Next
    
    Dim rr As Range
    Set rr = sh.Range("B2").Resize(UBound(arr, 1), UBound(arr, 2))
    rr.Value = arr
    rr.EntireColumn.AutoFit
End Sub

Private Sub Следующий_Click()
    Worksheets("Отчёт1. стр. (2)").Visible = True
    Worksheets("Отчёт1. стр. (2)").Activate
    Me.Visible = False
End Sub

=C1--(СЧЁТЕСЛИМН(Double[Итог];[@[Все_каб]];Double[Смена];C$1)=0)*(СЧЁТЕСЛИМН(Double[Итог];[@[Все_каб]])<2)*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

=B1--(СЧЁТЕСЛИМН(Double[Корр];[@[Все_каб]])<2)*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

Option Explicit

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
    ActiveSheet.Shapes(1).Delete
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Таблица1"
    ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight13"
    ActiveSheet.ListObjects(1).ShowTotals = True
    ActiveSheet.ListObjects(1).ListColumns("Статус").TotalsCalculation = xlTotalsCalculationCount
    ActiveSheet.ListObjects(1).ListColumns("Изменена").TotalsCalculation = xlTotalsCalculationNone
    ActiveSheet.ListObjects(1).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