Function MinNagr(Время_Наиб_Нагр$) As String
Dim Ar1, Ar2, ii&
    Ar1 = Split(Время_Наиб_Нагр, "-")
    For ii = LBound(Ar1) To UBound(Ar1)
        Ar2 = Split(Trim(Ar1(ii)), ";")
        If UBound(Ar2) = 0 Then
If Ar2(0) = "23:59:59" Then Exit For
If Ar2(0) <> "00:00:00" And MinNagr = "" Then
MinNagr = "00:00:00" & "-" & Format(TimeValue(Ar2(0)) - 1 / 86400, "hh:mm:ss")
Else
MinNagr = MinNagr & ";" & Format(TimeValue(Ar2(0)) + 1 / 86400, "hh:mm:ss") & "-" & "23:59:59"
End If
        Else
MinNagr = MinNagr & ";" & Format(TimeValue(Ar2(0)) + 1 / 86400, "hh:mm:ss") & "-" & Format(TimeValue(Ar2(1)) - 1 / 86400, "hh:mm:ss")
        End If
    Next ii
End Function

Sub aaaвв()
Range("P4").AutoFill Destination:=Range("P4").Resize(Range("A4").End(xlDown).Row - Range("P4").Row + 1) 'растянуть формулу
    Calculate 'пересчитать
With Range(Range("P5"), Range("P5").End(xlDown))
.Copy        'выделить вниз
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'вставить только значения
End With
End Sub

=ЕСЛИ((ПСТР($A2;СТОЛБЕЦ(A2);1)= "+");1;0)

=Ч(ПСТР($A2;СТОЛБЕЦ(A2);1)="+")

Sub enstaralfdh()
Dim Arr, ArByt() As Byte
ReDim Arr(VBA.Len(ActiveCell) - 1)
ArByt = VBA.StrConv(ActiveCell, vbFromUnicode)
For i = 0 To UBound(ArByt)
If ArByt(i) = 45 Then ArByt(i) = 48
If ArByt(i) = 43 Then ArByt(i) = 49
Arr(i) = VBA.Chr(ArByt(i))
Next
ActiveCell(, 2).Resize(, UBound(ArByt) + 1) = Arr
End Sub

Sub enstaralrt()
Dim DatN, Per&, i&, Sh1 As Worksheet, Rg1 As Range
Set Sh1 = ActiveWorkbook.ActiveSheet
DatN = Sh1.Range("B6"): Per = Sh1.Range("B8")
Set Rg1 = Sh1.Cells.Find(DatN, , xlFormulas, xlWhole, xlByRows)
If Rg1 Is Nothing Then Exit Sub
For i = 0 To (Rg1.End(xlToRight).Column - Rg1.Column) \ Per
Rg1.Offset(1, i * Per) = "Новый"
Next i
End Sub

=ЕСЛИ(ЕСЛИ(ЕОШ(РАЗНДАТ($B6;B2;"m")/$B$8);0,5;РАЗНДАТ($B6;B2;"m")/$B$8)=ЦЕЛОЕ(ЕСЛИ(ЕОШ(РАЗНДАТ($B6;B2;"m")/$B$8);0,5;РАЗНДАТ($B6;B2;"m")/$B$8));"Новый";"")

=ЕСЛИ(ЕОШИБКА(1/(ОСТАТ(РАЗНДАТ($B6;B2;"m");$B8)=0));"";"Новый")

Sub enstaraldsfg()
Dim Rg1 As Range, col1 As New Collection, Txt$, i&, j&, Tp1, Arr1
Set Rg1 = ActiveWorkbook.ActiveSheet.Cells(1).CurrentRegion
Arr1 = Rg1.Value
On Error Resume Next
For i = 2 To UBound(Arr1)
    Tp1 = VBA.Split(Arr1(i, 1), ";")
        For j = 0 To UBound(Tp1)
            col1.Add VBA.Trim(Tp1(j)), VBA.Trim(VBA.CStr(Tp1(j)))
         Next j, i
On Error GoTo 0
For i = 1 To col1.Count
If i = 1 Then Txt = col1(i) Else Txt = Txt & "; " & col1(i)
Next i
Rg1.Parent.Range("C1") = Txt
End Sub

Sub enstaralfh()
Dim Arr1, nRow&, i&, Sh2 As Worksheet, Rg1 As Range
Arr1 = ThisWorkbook.Worksheets(1).Cells(1).CurrentRegion
Set Sh2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
    For i = 1 To UBound(Arr1)
    nRow = Sh2.Cells.Find(Arr1(i, 4), , xlValues, xlWhole).Row
    Set Rg1 = Sh2.Cells.Find(Arr1(i, 2), , xlFormulas, xlWhole)
Sh2.Cells(nRow, Rg1.Column).Resize(, VBA.CLng(Arr1(i, 3)) - VBA.CLng(Arr1(i, 2)) + 1) = "a"
    Next i
End Sub

Sub enstaralfgh()
Dim Arr1, Tp1, nRow&, i&, j&, Dic1, Sh2 As Worksheet
Arr1 = ThisWorkbook.Worksheets(1).Cells(1).CurrentRegion
Set Sh2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
Set Dic1 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr1)
        If Not Dic1.Exists(Arr1(i, 4)) Then Dic1.Add Arr1(i, 4), New Collection
        Dic1(Arr1(i, 4)).Add VBA.CLng(Arr1(i, 2))
        Dic1(Arr1(i, 4)).Add VBA.CLng(Arr1(i, 3))
    Next i

    For Each Tp1 In Dic1.Keys()
    nRow = Sh2.Cells.Find(Tp1, , xlValues, xlWhole).Row
        For i = 2 To Dic1(Tp1).Count Step 2
            For j = Dic1(Tp1)(i - 1) To Dic1(Tp1)(i)
    Sh2.Cells(nRow, Sh2.Cells.Find(VBA.CDate(j), , xlFormulas, xlWhole).Column) = "a"
    Next j, i, Tp1
End Sub

    W = Split("250x300", "x")
    ReDim ZZ(UBound(W))
    For i = LBound(W) To UBound(W)
      ZZ(i) = CDbl(W(i))
    Next i
    Debug.Print Application.Max(ZZ)

Sub enstaralgg()
Dim Rg1 As Range, Sh2 As Worksheet, i&, kRow&: Const Chag% = 4
    Set Rg1 = ActiveWorkbook.ActiveSheet.Cells(1).CurrentRegion
    Set Sh2 = ActiveWorkbook.Worksheets("ИТОГ")
kRow = Rg1.Rows.Count: Application.ScreenUpdating = False: Sh2.Cells.Clear
Rg1.Cells(1, 1).Resize(kRow, Chag).Copy Sh2.Cells(1)
    For i = 1 + Chag To Rg1.Columns.Count Step Chag
    Rg1.Cells(1, i).Resize(kRow, Chag).Copy Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp)(2)
    Next i
End Sub

Function PodKol(Txt$, Optional OsnRaz$ = ",", Optional DopRaz$ = "-") As Long
Dim Tp1, Tp2, j&
    Tp1 = VBA.Split(Txt, OsnRaz)
        For j = 0 To UBound(Tp1)
            Tp2 = VBA.Split(Tp1(j), DopRaz)
            PodKol = PodKol + Tp2(UBound(Tp2)) - Tp2(0) + 1
         Next j
End Function

On Error Resume Next: ws.ShowAllData: On Error GoTo 0

If ws.FilterMode Then ws.ShowAllData

ws1.ListObjects(1).DataBodyRange.Delete