Sub ReadFromFiles()'получение свойств файлов из выбранной папки и запись на лист
    Dim strFolder$, arr() As Variant, i&, r As ListRow, c As Range
    strFolder = SelectFolder()
    If strFolder = "" Then Exit Sub
    With Application
        .ScreenUpdating = 0: .EnableEvents = 0
        Dim strFile$
        With CreateObject("DSOFile.OleDocumentProperties")
            strFile = Dir$(strFolder & "\*.jpg*")
            Do While Len(strFile)
                ReDim Preserve arr(5, i)
                arr(0, i) = strFile
                .Open strFolder & "\" & strFile, , 2
                Set ss = .SummaryProperties
                With .SummaryProperties
                    arr(2, i) = .Title
                    arr(3, i) = .Subject
                    arr(4, i) = .Keywords
                    arr(5, i) = .Comments
                End With
                .Close
                strFile = Dir$
                i = i + 1
            Loop
        End With
        With [Таблица1].ListObject
            .ListRows.Add 1
            .DataBodyRange.Delete
            .HeaderRowRange(2, 1).Resize(i, 6) = Application.Transpose(arr)
            For Each r In .ListRows
                Dim sd As ListRow
                Set c = r.Range(, 2)
                c.RowHeight = 60
                With ActiveSheet.Pictures.Insert(strFolder & "\" & c.Offset(, -1))
                    If .Width / .Height * c.RowHeight > c.Width - 2 Then
                        .Width = c.Width - 3
                    Else: .Height = c.RowHeight - 3
                    End If
                    .Top = c.Top + (c.Height - .Height) / 2
                    .Left = c.Left + (c.Width - .Width) / 2
                    .Placement = xlMoveAndSize
                End With
            Next
        End With
        .ScreenUpdating = 1: .EnableEvents = 1
    End With
End Sub
Sub Write2Files()'замена свойств файлов значениями с листа
    Dim strFolder$, r As ListRow
    strFolder = SelectFolder()
    If strFolder = "" Then Exit Sub
    With CreateObject("DSOFile.OleDocumentProperties")
        For Each r In [Таблица1].ListObject.ListRows
            .Open strFolder & "\" & r.Range(, 1), , 2
            With .SummaryProperties
                .Title = r.Range(, 7)
                .Subject = r.Range(, 8)
                .Keywords = r.Range(, 9)
                .Comments = r.Range(, 10)
            End With
            .Save: .Close
        Next
    End With
End Sub
Private Function SelectFolder$()
    With Application.FileDialog(msoFileDialogFolderPicker)
r:      If .Show Then
            SelectFolder = .SelectedItems(1)
        ElseIf MsgBox("Ничего не выбрано. Повторить?", 36, "Ну так как?") = 6 Then
            GoTo r
        Else: Exit Function
        End If
    End With
End Function

Sub d()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0: End With
            CreateObject("wscript.shell").Run _
                "cmd /c dir " & .SelectedItems(1) & _
                " /AD-H-L-S | clip", 0, 1
            With ActiveSheet
                .[A1:B1] = Array("Папка", "Дата создания")
                With Intersect(.UsedRange.Offset(1), .[A:B])
                    .Cells(1, 1).Select
                    .Delete xlUp
                End With
                .PasteSpecial "Текст"
                .UsedRange
                With Intersect(.UsedRange.Offset(1), .[A:A])
                    .Columns(1).TextToColumns [A2], 2, FieldInfo:=Array( _
                    Array(0, 4), Array(10, 9), Array(36, 2)), TrailingMinusNumbers:=1
                    .Offset(, 1).Cut
                    .Insert xlToRight
                    .Offset(.Rows.Count - 3, -1).Resize(2, 2).Delete xlUp
                    .Offset(, -1).Resize(5, 2).Delete xlUp
                End With
            End With
        End If
    End With
    With Application: .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With
End Sub

<input onclick="Object.prototype.forEach=Array.prototype.slice.call(this).forEach;var a=[Math.round($('.postRankName').width()/$(window).width()*100)+'%','inline','70%'];if($('.userAvatar')[0].style.width!='') {a=['25%','',''];this.value='Сузить'} else this.value='Расширить';$('.postTdTop .postUser').parent().forEach(function(item){item.style.width=a[0]});$('.postTdInfo td').forEach(function(item){item.style.display=a[1]});$('.userAvatar').forEach(function(item){item.style.width=a[2]})" value="Сузить" type="button">

frames =25

Duration =ABS(СУММ(МУМНОЖ(ОТБР(frames*60^{2:1:0}*ОТБР(ОСТАТ(A2:B2/10^{6:4:2};100))+ЕСЛИ({1:0:0};ОСТАТ(A2:B2;frames)));{-1:1})))

TC_out =СУММ(ОТБР(frames*60^{2:1:0}*ОТБР(ОСТАТ(E2:F2/10^{6:4:2};100))+ЕСЛИ({1:0:0};ОСТАТ(E2:F2;frames))))

=СУММ(ОТБР(ОСТАТ(ОТБР(Duration/frames)/60^{2;1;0};60))*10^{6;4;2};ОСТАТ(Duration;frames))*ЗНАК(B2-A2)

=СУММ(ОТБР(ОСТАТ(ОТБР(TC_out/frames)/60^{2;1;0};60))*10^{6;4;2};ОСТАТ(TC_out;frames))

Sub ss()
    Dim rng As Range
    With Range([A1], [A1].End(xlDown))
        Set rng = .Resize(.Count * [B1])
        .Copy rng
        With ActiveSheet.Sort
            With .SortFields
                .Clear
                .Add rng, 0, 1, , 0
            End With
            .SetRange rng: .Header = 2
            .MatchCase = 0: .Orientation = 1
            .SortMethod = 1: .Apply
        End With
    End With
End Sub

=ArrayFormula(DSUM(Q$1:U$89;U$1;IF({1;0};Q$1:T$1;D21:G21)))

Sub colorize()
    Dim cell As Range
    With Application
        .ScreenUpdating = 0: .EnableEvents = 0
        On Error Resume Next
        For Each cell In [A2].Resize([counta(A:A)]).Cells
            .CutCopyMode = False
            [E:E].Find(cell, , xlValues, xlWhole).Copy
            cell.PasteSpecial xlPasteAll
        Next
        .ScreenUpdating = 1: .EnableEvents = 1
    End With
End Sub

function AllRanges() {
    var sheets=SpreadsheetApp.getActiveSpreadsheet().getSheets();sheets.splice(-3,3);  
    var values=sheets.map(function(a){return a.getDataRange().getValues();});
    var combined=values.reduce(function(a, b){return a.concat(b.filter(function(c) {return c[0]!=a[0][0];}))});
    return combined  
}

=MAX(INDEX(OFFSET('Сводная таблица'!$B:$B;;;counta('Сводная таблица'!$A:$A)+1;COUNTA('Сводная таблица'!$1:$1));MATCH(A2;'Сводная таблица'!$A:$A;);))

=ArrayFormula(TEXTJOIN(";";1;if(INDEX(OFFSET('Сводная таблица'!$B:$B;;;counta('Сводная таблица'!$A:$A)+1;COUNTA('Сводная таблица'!$1:$1));MATCH(A2;'Сводная таблица'!$A:$A;);)=B2;OFFSET('Сводная таблица'!$B:$B;;;1;COUNTA('Сводная таблица'!$1:$1));"")))

Sub ViaDOM()
    Dim sFolder$, sXmlFile$, sXml$
    Dim cafe 'As IXMLDOMElement
    Dim food 'As IXMLDOMElement
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show Then sFolder = .SelectedItems(1) Else Exit Sub
    End With
    sXmlFile = Dir$(sFolder & "\*.xml")
    With CreateObject("MSXML2.DOMDocument.6.0")  'New MSXML2.DOMDocument60
        Do While sXmlFile <> ""
            .validateOnParse = False
            .Load sXmlFile
            sXml = .xml
            For Each cafe In .SelectNodes("//cafe")
                For Each food In cafe.ChildNodes
                    cafe.ParentNode.appendChild food
                Next
                cafe.ParentNode.RemoveChild cafe
            Next
            If sXml <> .xml Then
                .Save sXmlFile
            Else
                Debug.Print "в Файле"; sXmlFile; " элемент cafe не найден"
            End If
            sXmlFile = Dir$()
        Loop
    End With
End Sub

=ИНДЕКС(A1:A10;МЕДИАНА(0;ЯЧЕЙКА("строка");10))

=ВПР(A12;ДАТА!$A$1:$J$10;2;)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 And Not Intersect(Target, Me.[A1:A10]) Is Nothing Then _
    Me.[A12].Calculate
End Sub