Sub Поиск()
    Application.CommandBars.ExecuteMso "FindDialogExcel"
    SendKeys ("0")
End Sub

Sub Printer()
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    If MsgBox("Сохранить?", vbYesNo) = vbNo Then Exit Sub
    If MsgBox("Сохранить?", vbYesNo) = vbYes Then Worksheets("Импорт").Activate
    Call SaveTXT_UTF8
End Sub

=ЕСЛИОШИБКА(МЕДИАНА(400;ВПР(F2;aa;2)+(F2-ВПР(F2;aa;1))*ВПР(F2;aa;3)%;60000)/2;"")

Function WorklistCount()
WorklistCount = Application.ActiveSheet.PageSetup.Pages.Count
End Function

=ЕСЛИ(ДЛСТР(ПОДСТАВИТЬ(ПСТР(B1;ПОИСК("/";B1);3);"/";""))=1;"су "&ПОДСТАВИТЬ(ПСТР(B1;ПОИСК("/";B1);3);"/";"");"су"&ПОДСТАВИТЬ(ПСТР(B1;ПОИСК("/";B1);3);"/";""))

Function Tire$(x$)
    Tire = Split(x, "-")(UBound(Split(x, "-")))
End Function
Function Zapyat$(x$)
    Zapyat = Split(x, ", ")(UBound(Split(x, ", ")))
End Function
Function Zaplatka$(x$)
    Zaplatka = Split(x, ", ")(LBound(Split(x, ", ")))
End Function
Function Perlat$(x$)
    Perlat = Split(x, "-")(LBound(Split(x, "-")))
End Function

Sub Фильтр()
    Range("E1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$E$1:$F$161").AutoFilter Field:=1, Criteria1:=Array( _
        "Belly Dance & hot girl's", "Comedy ???", "Erotic video clip's", _
        "Georgian film's (Kartuli filmebi)", "Happy New Year Clip's", "Margalur prikoleb" _
        , "Sexy Girl's", "Turkish Clip's Music Video Top 100", "Абхазия", _
        "Грузинские супер клипы Top 200", "Иностранные супер клипы Top 200", _
        "Кавказские супер клипы Top 200", "Лучшее со всего мира", _
        "Мультфильмы (Самые лучшие)", "Николаев", "Один в Один! Ираклий Пирцхалава", _
        "РЖАКА :)", "Русские супер клипы Top 200", _
        "Самурзакано (Гали, Окуми, Ткварчели, Очамчире)", "Украинские приколы", _
        "Украинские супер клипы Top 200", "Художественные фильмы Top 200", _
        "ЭТО РОССИЯ, ДЕТКА!", "????? ????", _
        "??????? (Megruli, Margaluri, Lazuri, Мегрельская)", "??????????", _
        "??????? ????????? (Kartuli prikolebi)", "??????? ????? Грузинские танцы"), _
        Operator:=xlFilterValues
    ActiveWindow.SmallScroll Down:=-12
    Columns("E:F").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
End Sub

Function IskluchitBukv(stroka As String) As String
    Dim i As Integer
    For i = 1 To Len(stroka)
        If InStr(1, "1234567890-", Mid(stroka, i, 1)) <> 0 Then _
            IskluchitBukv = IskluchitBukv & Mid(stroka, i, 1)
    Next
End Function

Function YOUTUBEVIEW(ByVal URL As String) As Long
    Dim t$, v$
'---------------
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", URL, False
        .send
        Do: DoEvents: Loop Until .ReadyState = 4
        t = .responsetext
    End With
    With CreateObject("htmlFile")
        .Body.innerHTML = t
        For Each tg In .GetElementsByTagName("div")
            If tg.className = "watch-view-count" Then
                v = tg.innertext
                Exit For
            End If
        Next
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\D+"
        YOUTUBEVIEW = .Replace(v, "")
    End With
End Function

Private Sub Workbook_Open()
    Call Main
End Sub

Sub Main()
    Application.OnTime Now + TimeValue("00:00:10"), "ReLinks"
End Sub

Sub ReLinks()
    ThisWorkbook.UpdateLink Name:=ThisWorkbook.LinkSources
    Main
End Sub

Private Sub Menu2_Click()
 Навигация.Show
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
     
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("C1")) Is Nothing Then  'если изменененная ячейка попадает в диапазон C1
            With cell.Offset(0, 0)         'вводим туда же
               .Value = Date - 1
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
        If Not Intersect(cell, Range("D1")) Is Nothing Then  'если изменененная ячейка попадает в диапазон D1
            With cell.Offset(0, 0)         'вводим туда же
               .Value = Date
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
    Next cell
End Sub