Cells(1) = Shell("C:\Program Files\Windows Media Player\wmplayer.exe C:\Users\1.mp3", vbHide)

Shell "TaskKill /F /PID " & CStr(Cells(1)), vbHide

Shell "C:\Program Files\Windows Media Player\wmplayer.exe C:\Users\1.mp3", 0

With CreateObject("WScript.Shell")
.Run "C:\Users\1.mp3", 0
End With

Function Max_Min_Data(DiapDat As Range, DiapSum As Range, Optional Max_Min% = 1) As Double
Dim Ar1, Ar2
Ar2 = DiapDat.Value: Ar1 = DiapSum.Value
For i = 1 To UBound(Ar1, 2)
If Ar1(1, i) <> "" Then Ar1(1, i) = VBA.CDbl(Ar2(1, i))
Next i
If Max_Min = 0 Then Max_Min_Data = WorksheetFunction.Min(Ar1) Else Max_Min_Data = WorksheetFunction.Max(Ar1)
End Function

=1/МАКС(1/$E$2:$N$2*ЕЧИСЛО(E3:N3))

=МАКС($E$2:$N$2*ЕЧИСЛО(E3:N3))

Function Оценки(диапазон As Range, критерий%) As Long
Dim arr, i&, j&
arr = диапазон.Value: Оценки = UBound(arr)
For i = 1 To UBound(arr): For j = 1 To UBound(arr, 2)
If arr(i, j) < критерий Or Not VBA.IsNumeric(arr(i, j)) Then Оценки = Оценки - 1: Exit For
Next j, i
End Function

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 MinNagr = "" Then
If Ar2(0) <> "00:00:00" 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
If MinNagr Like ";*" Then MinNagr = VBA.Mid(MinNagr, 2)
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