Sub xx()
    With Application
        .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = False
        Open ActiveWorkbook.Path & "\8037208.txt" For Input As #1
        With GetObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText Input$(LOF(1), 1)
            .PutInClipboard
        End With
        Close #1
        With [C5:F5]
            Range(.Cells, .End(xlDown)).ClearContents
            .Cells(1).PasteSpecial xlPasteAll
            .Copy
        End With
        .CutCopyMode = 0
        .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1
    End With
End Sub

=МИН(СУММ(B3:E3);100)

=СУММ(B3:E3)-F3

Private Sub CommandButton1_Click()
    Dim var As Variant, sel As Range, s%
    Set sel = Selection.Range
    Application.ScreenUpdating = False
    s = ActiveDocument.Windows(1).VerticalPercentScrolled
    For Each var In Array("Текст1", "ТекстМ2", "Текст3К")
        With Selection.Find
            .ClearFormatting
            .Wrap = wdFindContinue
            .Text = var
            .Execute
            Do
                Selection.Collapse wdCollapseEnd
                Selection.Range.Paragraphs(1).Style = ActiveDocument.Styles(-2)
                .Execute
            Loop Until Not .Found
        End With
    Next
    sel.Select
    ActiveDocument.Windows(1).VerticalPercentScrolled = s
    Application.ScreenUpdating = True
End Sub

ActiveDocument.Styles(-2)

o=1
For Each p In Array(r, w, e, x, t, y, u, i)
    arr(q, o) = p
    o = o + 1
Next

=СЧЁТЕСЛИМН(Таблица6[[#Заголовки];[3]]:[@3];[@3];Таблица6[[#Заголовки];[4]]:[@4];[@4];Таблица6[[#Заголовки];[5]]:[@5];[@5];Таблица6[[#Заголовки];[6]]:[@6];[@6])

=[@7]

On Error Resume Next
Set excelapp = GetObject(, "excel.application")
If excelapp Is Nothing Then
    Err.Clear
    Set excelapp = CreateObject("excel.application")
    excelapp.Workbooks.Add
End If
With excelapp
    with .AddIns
        .Add "\\Server\общая\Program Files\Microsoft Office\ADDINS\md5.xlam", False
        .Item("md5").Installed = true
    End With
    If Err = 0 Then MsgBox "надстройка md5 установлена успешно"
    if not excelapp.visible then excelapp.quit
end with

=Ч(СЧЁТ(ПОИСК(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(G$4;"+";ПОВТОР(" ";99));СТОЛБЕЦ($A7:ИНДЕКС(7:7;1+ДЛСТР(G$4)-ДЛСТР(ПОДСТАВИТЬ(G$4;"+";))))*99-98;99));C7:C9&D7:D9))>ДЛСТР(G$4)-ДЛСТР(ПОДСТАВИТЬ(G$4;"+";)))

=Ч(СЧЁТ(ПОИСК(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(G$4;"+";ПОВТОР(" ";99));СТОЛБЕЦ($A7:ИНДЕКС(7:7;1+ДЛСТР(G$4)-ДЛСТР(ПОДСТАВИТЬ(G$4;"+";))))*99-98;99));ИНДЕКС(C7:D9;Ч(ИНДЕКС(ОКРВВЕРХ(СТРОКА(A$1:ИНДЕКС(A:A;ЧСТРОК(C7:D9)*ЧИСЛСТОЛБ(C7:D9)))/ЧИСЛСТОЛБ(C7:D9);1);0));Ч(ИНДЕКС(ОСТАТ(СТРОКА(A$1:ИНДЕКС(A:A;ЧСТРОК(C7:D9)*ЧИСЛСТОЛБ(C7:D9)))-1;ЧИСЛСТОЛБ(C7:D9))+1;0)))))>ДЛСТР(G$4)-ДЛСТР(ПОДСТАВИТЬ(G$4;"+";)))

=СЧЁТ(1/(МУМНОЖ(ИНДЕКС(МУМНОЖ(ЕСЛИОШИБКА(ПОИСК(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(G4;"+";ПОВТОР(" ";99));СТОЛБЕЦ(A1:ИНДЕКС(1:1;1+ДЛСТР(G4)-ДЛСТР(ПОДСТАВИТЬ(G4;"+";))))*99-98;99));D7:D33)^0;);ТРАНСП(СТОЛБЕЦ(A1:ИНДЕКС(1:1;1+ДЛСТР(G4)-ДЛСТР(ПОДСТАВИТЬ(G4;"+";)))))^0);Ч(ИНДЕКС(СТРОКА(A1:ИНДЕКС(A:A;ЧСТРОК(D7:D33)/3))*3-3+{1;2;3};;)));{1:1:1})>ДЛСТР(G4)-ДЛСТР(ПОДСТАВИТЬ(G4;"+";))))

Function ОбъединитьСРазделителем(Разделитель As String, ParamArray Значения()) As String
    Dim result As String, arg, arr As Variant, rc As Variant
    For Each arg In Значения
        Select Case TypeName(arg)
        Case "Range"                     'это диапазон
            arr = IIf(arg.Count > 1, arg.Value, Array(arg.Value))
        Case "Variant()"                 'это массив
            arr = arg
        Case Else
            arr = Array(arg)
        End Select
        'цикл по всем значениям массива
        For Each rc In arr
            If Not IsEmpty(rc) And rc <> "" Then
                result = result & IIf(result <> "", Разделитель, "") & rc
            End If
    Next rc, arg
    ОбъединитьСРазделителем = result
End Function

=СУММ(ЕСЛИОШИБКА(1/СЧЁТЕСЛИМН(Лист1!$A$1:$A$36;Лист1!$A$1:$A$36;Лист1!$B$1:$B$36;C$1;Лист1!$C$1:$C$36;$B2);))

Private Const Login$ = "логин", Pwd$ = "пароль""
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", urlencode(Host & RemoteFilePath$), True
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Authorization", "Basic " & Token
        .send
        .WaitForResponse
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, Optional RemotePath$ = "/", Optional RemoteFilename$ = "")
    Dim FileContents As Variant, FileName$
    RemotePath = RemotePath & IIf(Right(RemotePath, 1) = "/", "", "/")
    RemoteFilename = IIf(Len(RemoteFilename), RemoteFilename, StrReverse(Split(StrReverse(LocalFilePath), "\")(0)))
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "PUT", urlencode(Host & RemotePath & RemoteFilename), False
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Etag", MD5(FileContents)
        .SetRequestHeader "Sha256", Sha256(FileContents)
        .SetRequestHeader "Expect", "100-continue"
        .SetRequestHeader "Content-Type", "application/binary"
        .SetRequestHeader "Authorization", "Basic " & Token
        .SetRequestHeader "Content-Length", UBound(FileContents) + 1
        .send FileContents
        .WaitForResponse
        Debug.Print .statustext
        Debug.Print "Файл "; IIf(.statustext = "Created", "успешно загружен", "не загружен")
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login & ":" & Pwd): Token = .Text
    End With
End Function

=СУММ(ЕСЛИОШИБКА(ПСТР(0&A4;ПОИСК({"h";"m";"s"};0&A4)-2;2)/24/60^{0;1;2};))

=-ПРОСМОТР(;-ПОДСТАВИТЬ(ЛЕВБ(A1;{5;6})&ПРАВБ(A1;5);"ая";"ай"))

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 999) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути найденных файлов
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Dim FSO As New FileSystemObject       ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep    ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO As FileSystemObject, _
                    ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    Dim curfold As Folder, sfol As Folder, fil As File
    Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        ' раскомментируйте эту строку для вывода пути к просматриваемой
        ' в текущий момент папке в строку состояния Excel
        Application.StatusBar = "Поиск в папке: " & FolderPath

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже
            For Each sfol In curfold.SubFolders    ' ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If

ReminderTime = Date + 33/24

Sub Нарисовать()
Dim o1 As Shape, o2 As Shape
Set o1 = ActiveSheet.Shapes([E3])
Set o2 = ActiveSheet.Shapes([E6])
Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb!
GetParam o1, x1, y1, r1
GetParam o2, x2, y2, r2
Dim i&, j&, p#, l!, lmin!
Dim x1t!, y1t!, x2t!, y2t!, bc&, ec&
p = Atn(1)
lmin = [a65536].Top - [a1].Top
For i = 0 To 7
  x1t = x1 + Cos(p * i) * r1
  y1t = y1 - Sin(p * i) * r1
  For j = 0 To 7
    x2t = x2 + Cos(p * j) * r2
    y2t = y2 - Sin(p * j) * r2
    l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2)
    If l < lmin Then
      lmin = l
      xa = x1t
      ya = y1t
      xb = x2t
      yb = y2t
      bc = i
      ec = j
    End If
  Next
Next
With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb)
    .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1
    .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1
    .Name = [E3] & "|" & [E6]
End With
End Sub

Sub Удалить()
    On Error Resume Next
    ActiveSheet.Shapes([E3] & "|" & [E6]).Delete
    If Err = 0 Then Exit Sub
    Dim o1 As Shape, o2 As Shape, o3 As Shape, o4 As Shape
    Set o1 = ActiveSheet.Shapes([E3])
    Set o2 = ActiveSheet.Shapes([E6])
    For Each sh In ActiveSheet.Shapes
        If sh.Connector Then
            With sh.ConnectorFormat
                Set o3 = .BeginConnectedShape
                Set o4 = .EndConnectedShape
                If o1 Is o3 And o2 Is o4 Or o1 Is o4 And o2 Is o3 Then
                    sh.Delete
                    Exit For
                End If
            End With
        End If
    Next
End Sub