Sub Макрос1()
    Dim dt As Date
    
    dt = Date + 1
    With Application
        .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet
            If .FilterMode Then .ShowAllData
            With .UsedRange
                With Intersect(.Cells, .Offset(2))
                    .Rows.Hidden = True
                    If .Find(dt, , xlFormulas) Is Nothing Then GoTo x
                    .Replace dt, "=zz1", 2, , , , False, False
                End With
             End With
        End With
        On Error Resume Next
        With [zz1].Dependents
            .Rows.Hidden = False
            .Formula = dt
        End With
x:      .EnableEvents = 1: .ScreenUpdating = 1
    End With
End Sub

Sub Макрос1()
    With Application
        .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet
            If .FilterMode Then .ShowAllData
            With .UsedRange
                With Intersect(.Columns("N:O"), .Offset(1))
                    .Replace Date, "=zz1", 2, , , , False, False
                    .Rows.Hidden = True
                End With
             End With
        End With
        With [zz1].DirectDependents
            .Rows.Hidden = False
            .Formula = Date
        End With
        .EnableEvents = 1: .ScreenUpdating = 1
    End With
End Sub

Sub Макрос1()
    With Application
        .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet
            With .AutoFilter
                If .FilterMode Then .ShowAllData
            End With
            With .UsedRange
                With Intersect(.Cells, .Offset(2))
                    .Replace Date, "=zz1", 2, , , , False, False
                    .Rows.Hidden = True
                End With
             End With
        End With
        With [zz1].Dependents
            .Rows.Hidden = False
            .Formula = Date
        End With
        .EnableEvents = 1: .ScreenUpdating = 1
    End With
End Sub

Function ccc$(t$)
With CreateObject("VBScript.RegExp"): .Pattern = "\d{4}(?=\d)":ccc = .Replace(t, "$&-")
  End With
End Function

Private Sub UserForm_Initialize()
    
    Dim iLastRow As Long
    Dim Dic As Object
    
    iLastRow = Sheets("Журнал ИБ").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Akt = iLastRow - 4
    'Cells(iLastRow, 1) = Akt
    
    karta1 = Akt
    
    'zakaz = Application.Max(Sheets("Журнал ИБ").Range("N5:N")) + 1
    'spisanie = Application.Max(Sheets("Журнал ИБ").Range("O5:O")) + 1
    zakaz = Akt
    spisanie = Akt
   
    Data1 = Format(Date, "dd.mm.yyyy")
    Data2 = Format(Date, "dd.mm.yyyy")
    Data3 = Format(Date, "dd.mm.yyyy")
    Data4 = Format(Date, "dd.mm.yyyy")
    
    'список для наименований
    Dim i As Long
    i = 2
    Do While Sheets("reestr").Cells(i, 4) <> 0
        name1.AddItem Sheets("reestr").Cells(i, 4)
        i = i + 1
    Loop
     
    remont.List = Array("ТО-1", "ТО-2", "ТО-3", "ТО-4", "ТР-1", "ТР-2", "ТР-3", "СР", "КР", "ВП", "СП", "Ревизия")
    reshenie.List = Array("Р", "У", "Г", "Д")
      
      
    'списки фамилий
    Set Dic = CreateObject("Scripting.Dictionary")
    Populate fio1, ['Журнал ИБ'!K5], Dic
    Populate fiosklad1, ['Журнал ИБ'!L5], Dic
    Populate fiosklad2, ['Журнал ИБ'!R5], Dic
    Populate fio2, ['Журнал ИБ'!S5], Dic
    Populate ceh1, ['Журнал ИБ'!Q5], Dic
    Populate ceh2, ['Журнал ЗС'!H5], Dic
    Populate fio3, ['Журнал ИБ'!I5], Dic
    Populate fio4, ['Журнал ЗС'!J5], Dic
    Populate fio5, ['Журнал ЗС'!N5], Dic
    Populate fiosklad5, ['Журнал ЗС'!O5], Dic
    Set Dic = Nothing
End Sub
Private Sub Populate(ByRef ctrl As Control, ByRef Cell As Range, ByRef Dic As Object)
    Dim arr As Variant
    With Cell.Parent
        arr = .Range(Cell, .Cells(.Rows.Count, Cell.Column).End(xlUp))
    End With
    If IsArray(arr) Then
        With Dic
            .RemoveAll
            For i = LBound(arr) To UBound(arr)
                .Item(arr(i, 1)) = 1
            Next
            ctrl.List = .Keys
        End With
    Else
        ctrl.List = Array(arr)
    End If
End Sub

=СУММ(ПОДСТАВИТЬ(ПРАВБ(F7:J7;5);"/";)-ЛЕВБ(F7:J7;5))

=СУММ(ПСТР(F7:J7;ПОИСК("/";0&F7:J7)^{0:1};5)*{-1:1})

=СУММ(ПОДСТАВИТЬ(ПРАВБ(F7:J7;5);"/";)-ЛЕВБ(F7:J7;5))

=СУММПРОИЗВ(ЕСЛИОШИБКА(ИНДЕКС(E3:E50;Ч(ИНДЕКС(ПОИСКПОЗ(N3:N18;A3:A50;);{0}))););O3:O18)

=СУММ((A3:A50=ТРАНСП(N3:N18))*E3:E50*Ч(ТРАНСП(O3:O18)))

Option Explicit
Sub Raschet()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Calc [Sens!C80], [Sens!C81], [Sens!B14:B20].Value, Array(13, 47)
    Calc [Sens!C81], [Sens!C82], [Sens!B23:B29].Value, Array(23, 57)
    Calc [Sens!C83], [Sens!C84], [Sens!B33:B39].Value, Array(33, 67)
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub Calc(ByRef r1 As Range, ByRef r2 As Range, arr1 As Variant, arr2 As Variant)
Dim a&, i&, j&, r As Variant, v As Variant
    For a = 3 To 9
        r1 = Cells(arr2(0), a)
        i = 0
        For Each v In arr1
            r2 = v
            Application.Calculate
            i = i + 1
            For Each r In arr2
                For j = 0 To 20 Step 10
                    Cells(r + i, a + j) = [Sens!B1].Offset(r - 1, j)
    Next j, r, v, a
    r1 = 1
End Sub

Sub Raschet()
    Dim i&, j&, r As Variant, v As Variant, a&
    Dim Inp1 As Range
    
    Set Inp1 = [Sens!C80]
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For a = 3 To 9
        Inp1 = Cells(13, a)
        i = 0
        For Each v In [Sens!B14:B20].Value
            [Sens!C81] = v
            Application.Calculate
            i = i + 1
            For Each r In Array(13, 47)
                For j = 0 To 20 Step 10
                    Cells(r + i, a + j) = [Sens!B1].Offset(r - 1, j)
    Next j, r, v, a
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

// ==UserScript==
// @name         Kludge
// @match        http://www.excelworld.ru/*
// @grant        GM_addStyle
/*jshint multistr: true */
// ==/UserScript==

GM_addStyle (
'.switch, .switchActive,  .pagesInfo {\
    border: 1px solid rgb(169, 169, 169)!important;\
    display: table-cell!important;\
    min-width: 1.6em;\
    text-align: center;\
}\
.switches {\
    display: table;\
    border-collapse: collapse;\
}'
);

gg1 = Format(ActiveSheet.Cells(1, 1), "0000")

Private Sub CommandButton1_Click()
    Me.Hide
    On Error Resume Next
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet.UsedRange
            Intersect(.Cells, .Offset(1)).Delete xlUp
        End With
        With ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    With ThisWorkbook.Sheets(.List(i)).UsedRange
                        Intersect(.Cells, .Offset(1)).Copy _
                            [A1].Offset(Cells(Rows.Count, 1).End(xlUp).Row)
                    End With
                End If
            Next
        End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Sheets
        If Not SH Is ActiveSheet Then Me.ListBox1.AddItem SH.Name
    Next
End Sub