=СЧЁТЕСЛИ(ИНДЕКС('1'!$A:$Z;ПОИСКПОЗ(9E+307;'1'!$A:$A););"*"&B1)

Sub Кнопка2_Щелчок()
    Dim c As Range
    With Application: .ScreenUpdating = 0: .EnableEvents = 0
    With ActiveSheet.UsedRange
        .AutoFilter Field:=1, Criteria1:="214050000"
        .AutoFilter Field:=3, Criteria1:="3"
        .AutoFilter Field:=4, Criteria1:="91301"
        With .SpecialCells(12).Areas
            Set c = .Item(.Count).Rows(IIf(.Count > 1, 1, 2))
            c.Cells(3) = 10
        End With
        .AutoFilter Field:=3
        .AutoFilter Field:=4
        c.Rows.Hidden = True
        .Offset(1).SpecialCells(12).Rows.Delete xlUp
        .AutoFilter
    End With
    .ScreenUpdating = 1: .EnableEvents = 1: End With
End Sub

=ЕСЛИ(СЧЁТ(1/(B$2:B2=B2)/(МУМНОЖ(--($A$2:A2*{1;-1}>=ДАТАМЕС(A2;{-1;1})*{1;-1});{1:1})=2))=1;СЧЁТ(1/($B$2:$B$45=B2)/(МУМНОЖ(--($A$2:$A$45*{1;-1}>=ДАТАМЕС(A2;{-1;1})*{1;-1});{1:1})=2))-1;"")

=СУММПРОИЗВ((ПРАВБ('2'!$A1:$S1;ДЛСТР(B$1))=B$1)*('2'!$D1:$V1>'2'!$E1:$W1))

        rRoute.Replace vbCrLf, vbLf
        rRoute.Replace vbLf, vbCrLf
        For Each rcell In rRoute
            If bNext Then lNext = rcell.Row: bNext = 0
            If rcell = Me.Label1.Caption Then lRow = rcell.Row: bNext = 1
            ii = ii + 1: If ii = rRoute.Count Then lLast = rcell.Row
        Next rcell

Dim btn As Button
Sub Уменьшить_размер_шрифта_на_кнопках()
    For Each btn In ActiveSheet.Buttons
        With btn.Font
            .Size = .Size - 1
        End With
    Next
End Sub
Sub Увеличить_размер_шрифта_на_кнопках()
    For Each btn In ActiveSheet.Buttons
        With btn.Font
            .Size = .Size + 1
        End With
    Next
End Sub

=ИНДЕКС(ДВССЫЛ($D$4;);СТРОКА(A1);СТОЛБЕЦ(A1))

=СУММ(ИНДЕКС(X$1:X$3;Ч(ИНДЕКС(1+ОСТАТ(ЦЕЛОЕ((СТРОКА()-1)/{1:3:9:27});3);)))*A$1:A$4)

If CDate(inData.Cells(j, 2)) < CDate(rRow.Cells(3)) And CDate(rRow.Cells(3)) < CDate(inData.Cells(j, 2)) + TimeSerial(0, 40, 0) Then

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