Sub DownloadAndInstallAddInW()
    ' Your code here to download the latest Add-In version
    Dim downloadURL As String

    
    'Application.AddIns("New One").Installed = False
    downloadURL = "https://drive.google.com/uc?export=download&id=1-_XQWIJVgMUFU253id1d_dn8PlHfb5X-" ' Replace with the actual download URL

    ' Specify the local path for saving the downloaded Add-In
    Dim localPath As String
    localPath = Environ("USERPROFILE") & "\Desktop\New One.xlam" ' Replace with your desired local path

    ' Download the Add-In
    DownloadFileW downloadURL, localPath
    
    'Call Add_AddinW
    
    MsgBox "Надстройка успешно обновлена!"
End Sub

' Function to download a file from a URL
Sub DownloadFileW(url As String, localPath As String)
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    WinHttpReq.Open "GET", url, False
    WinHttpReq.Send

    If WinHttpReq.Status = 200 Then
        Dim oStream As Object
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile localPath, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    Else
        MsgBox "Failed to download the Add-In. Status: " & WinHttpReq.Status
    End If
End Sub




Sub Add_AddinW()

If Application.AddIns("New One").Installed = True Then

Application.AddIns("New One").Installed = False

With Application
    .AddIns.Add Environ("USERPROFILE") & "\Desktop\New One.xlam", True

End With
End If
If Application.AddIns("New One").Installed = False Then
Application.AddIns("New One").Installed = True
End If
End Sub

Sub Создать_График()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, j As Long, k As Long
    Dim name As String
    Dim startDateTime As Date, endDateTime As Date
    Dim currentDateTime As Date
    Dim hoursDiff As Integer
    Dim presenceCount As Integer
    Dim nameColumn As Integer
    Dim uniqueNames As Collection

    ' Указываем листы
    Set ws1 = ThisWorkbook.Sheets("Лист1")
    Set ws2 = ThisWorkbook.Sheets("Лист2")

    ' Находим последнюю заполненную строку на Листе1 и Листе2
    lastRow1 = ws1.Cells(ws1.Rows.count, "B").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.count, "A").End(xlUp).Row

    ' Находим последний столбец с именами на Листе2
    nameColumn = ws2.Cells(1, ws2.Columns.count).End(xlToLeft).Column

    ' Инициализируем коллекцию для хранения уникальных имен
    Set uniqueNames = New Collection

    ' Проходим по каждой строке на Листе1
    For i = 2 To lastRow1
        ' Получаем имя
        name = ws1.Cells(i, 1).Value

        ' Проверяем, является ли имя уникальным
        On Error Resume Next
        uniqueNames.Add name, CStr(name)
        On Error GoTo 0
    Next i

    ' Добавляем уникальные имена на Лист2
    For i = 1 To uniqueNames.count
        If Application.WorksheetFunction.CountIf(ws2.Range("A:A"), uniqueNames.Item(i)) = 0 Then
            ws2.Cells(lastRow2 + i, 1).Value = uniqueNames.Item(i)
        End If
    Next i

    ' Проходим по каждой строке в Листе2 (каждому уникальному имени)
    For i = 2 To lastRow2 + uniqueNames.count
        ' Получаем имя
        name = ws2.Cells(i, 1).Value

        ' Проходим по каждой строке на Листе1
        For j = 2 To lastRow1
            ' Проверяем, совпадает ли имя на Листе1 с текущим именем на Листе2
            If ws1.Cells(j, 1).Value = name Then
                ' Получаем дату и время начала и окончания работы
                startDateTime = ws1.Cells(j, 2).Value
                endDateTime = ws1.Cells(j, 3).Value

                ' Проходим по каждому часу в промежутке между началом и окончанием работы
                For k = 0 To DateDiff("h", startDateTime, endDateTime)
                    currentDateTime = DateAdd("h", k, startDateTime)

                    ' Подсчитываем присутствие в каждом часе
                    If currentDateTime >= ws2.Cells(1, 2).Value And currentDateTime <= ws2.Cells(1, ws2.Columns.count).End(xlToLeft).Value Then
                        hoursDiff = DateDiff("h", ws2.Cells(1, 2).Value, currentDateTime) + 1
                        presenceCount = ws2.Cells(i, hoursDiff).Value
                        ws2.Cells(i, hoursDiff).Value = presenceCount + 1
                    End If
                Next k
            End If
        Next j
    Next i

    ' Форматируем данные на Листе2
    ws2.Rows(1).AutoFilter
    ws2.Columns.AutoFit

End Sub

Function CustomFilterFunction(dayweekcrit As Variant, timecrit As Double, qcrit As Variant) As Variant
'dayweekcrit As Variant, timecrit As Variant

Dim result As Double
Dim findcount As Long
Dim sumvolume As Double
findcount = 0
sumvolume = 0
    'Dim i As Integer
    'Dim j As Integer
    

    
Dim Volumerange As Range
Dim dayweekrange As Range
Dim timerange As Range
Dim qrange As Range

Dim volumeArray() As Variant
Dim dayweekarray() As Variant
Dim timearray() As Variant
Dim qarray() As Variant




Worksheets("History").Activate
Set Volumerange = Worksheets("History").Range("AL3:AL" & Worksheets("History").Cells(Rows.count, "AL").End(xlUp).Row)
Set dayweekrange = Worksheets("History").Range("AP3:AP" & Worksheets("History").Cells(Rows.count, "AL").End(xlUp).Row)
Set timerange = Worksheets("History").Range("AS3:AS" & Worksheets("History").Cells(Rows.count, "AL").End(xlUp).Row)
Set qrange = Worksheets("History").Range("AK3:AK" & Worksheets("History").Cells(Rows.count, "AK").End(xlUp).Row)





volumeArray() = Volumerange.Value
dayweekarray() = dayweekrange.Value
timearray() = timerange.Value
qarray() = qrange.Value
For i = 1 To Worksheets("History").Cells(Rows.count, "AL").End(xlUp).Row - 2
If qrange.Cells(i).Value = qcrit And dayweekrange.Cells(i).Value = dayweekcrit And timerange.Cells(i).Value = timecrit Then
sumvolume = sumvolume + Volumerange.Cells(i).Value
findcount = findcount + 1


End If


Next

CustomFilterFunction = sumvolume

End Function

Sub MyMacro()

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Range("E95:AI118").FormulaLocal = "=СУММПРОИЗВ(ЕСЛИОШИБКА(ЕСЛИ(ЛЕВСИМВ(E$20:E$80;5)*1<=$D95;1;0);0)*1;ЕСЛИОШИБКА(ЕСЛИ(ПРАВСИМВ(E$20:E$80;5)*1>$D95;1;0);0)*1)+СУММПРОИЗВ(ЕСЛИОШИБКА(ЕСЛИ(ЛЕВСИМВ(E$20:E$80;5)*1<=$D95;1;0);0)*1;ЕСЛИОШИБКА(ЕСЛИ(ПРАВСИМВ(E$20:E$80;5)*1<$D95;1;0);0)*1;ЕСЛИОШИБКА(ЕСЛИ(ЛЕВСИМВ(E$20:E$80;5)*1>ПРАВСИМВ(E$20:E$80;5)*1;1;0);0)*1)+СУММПРОИЗВ(ЕСЛИОШИБКА(ЕСЛИ(ПРАВСИМВ(D$20:D$80;5)*1<ЛЕВСИМВ(D$20:D$80;5)*1;1;0);0)*1;ЕСЛИОШИБКА(ЕСЛИ(ПРАВСИМВ(D$20:D$80;5)*1<=$D95;0;1);0)*1)"
   

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B3")) Is Nothing Then
Application.EnableEvents = False
Sheets("РМ").Cells(Target.Row, 3) = Target.Value
Sheets("Переменные").Cells(Target.Row, 3) = Target.Value // Добавил сюда строчку. Работает на 3 листах
Application.EnableEvents = True
End If
End Sub