9+3+9+0+3+9+6+9=48

4+8=12

1+2=3

Sub ПрикрепитьФайл()    ' прикрепляем файл к книге Excel
    If IsError([SheetForAttachedFiles!A1]) Then
        With ThisWorkbook.Sheets
            With .Add(.Item(1))
                .Visible = xlVeryHidden
                .Name = "SheetForAttachedFiles"
            End With
        End With
    End If
    Dim FileManager As New AttachedFiles, res As Boolean
    res = FileManager.AttachNewFile(Environ("windir") & "\system32\mscomct2.ocx")
End Sub

Sub ИзвлечьФайл()    ' извлекаем и регистрируем
    Dim FileManager As New AttachedFiles, res As Boolean
    On Error Resume Next ' на случай, если среди вложений нет файла mscomct2.ocx
    If Dir$(Environ("windir") & "\system32\mscomct2.ocx") = "" Then _
    res = FileManager.GetAttachment("mscomct2.ocx").SaveAs(Environ("windir") & "\system32\mscomct2.ocx")
    CreateObject("wscript.shell").Run ("regsvr32.exe """ & Environ("windir") & "\system32\mscomct2.ocx" & """ /s")
End Sub

R =

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With
    Select Case False
        Case Intersect(Target, Range("B4:C200")) Is Nothing
            With Cells(Target.Row, "A")
                If IsEmpty(.Cells) Then .Value = Now()
            End With
        Case Intersect(Target, Range("L4:L200")) Is Nothing
            With Cells(Target.Row, "M")
                If IsEmpty(.Cells) Then .Value = Now()
            End With
    End Select
    With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With
End Sub

Sub dd()
    Dim ar As Range, cell As Range, s%
    With Application: .ScreenUpdating = 0: .EnableEvents = 0:  End With
    With Cells(Rows.Count, 2).End(xlUp)
        With .Offset(4 - .Row).Resize(.Row - 4)
            If MsgBox("Очистить заполненные ячейки?", 36) = 6 Then _
                .Offset(, 3).ClearContents
            On Error Resume Next
            .Replace "Выплата", "=ZZ1"
            For Each ar In [ZZ1].Dependents.Areas
                For Each cell In ar.Cells
                    With cell
                        .Offset(, 3).Value = "-"
                        [F2].Formula = Join(Array("=SUMPRODUCT(D4:D", ",F4:F", _
                            "*ISBLANK(E4:E", ")*ISTEXT(B4:B", ")*(COUNTIFS($D$4:$D$", _
                            ",$D$4:$D$", ",$E$4:$E$", ","""",$C$4:$C$", ",""<""&C4:C", ")=0))-" & _
                            .Offset(0, 2).Value), .Row - 1)
                        [G2].Formula = "=$F$2=0"
                        [G3].Formula = "=COUNT($F$4:$F$" & .Row - 1 & ")"
                        [G4].FormulaArray = "=$F$4:$F$" & .Row - 1 & "=INT($F$4:$F$" & .Row - 1 & ")"
                        [G5].FormulaArray = "=$F$4:$F$" & .Row - 1 & "<=1"
                        [G6].FormulaArray = "=$F$4:$F$" & .Row - 1 & ">=0"
                        Solver.SolverLoad [G2:G6], False
                        SolverOk "$F$2", 3, 0, "$F$4:$F$" & .Row - 1, 2, "Simplex LP"
                        Select Case Solver.SolverSolve(True)
                            Case 0, 14
                    [F:F].Replace 1, "=ZZ2", xlWhole
                    [F2,G2:G6].ClearContents
                    Intersect([E:E], [ZZ2].Dependents.EntireRow).Value = .Offset(, 1)
                        End Select
                        .Value = "Выплата"
                    End With
            Next cell, ar
            .Offset(, 3).SpecialCells(4).Value = "Не выплачено"
            .Offset(-2, 4).Resize(.Count + 2, 2).ClearContents
        End With
    End With
    With Application: .ScreenUpdating = 1: .EnableEvents = 1: 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

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

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 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