Option Explicit
Option Base 1
Sub Ynicom()
    Dim arrData() As Date, myDictionary As Object, myCell As Range, Sh7 As Worksheet, lLastRow7A As Long
        Set Sh7 = Лист7
        Set myDictionary = CreateObject("Scripting.Dictionary")
            lLastRow7A = Sh7.Cells(Rows.Count, 1).End(xlUp).Row
    
'Отбор уникальных значений из диапазона
        On Error Resume Next
            For Each myCell In Sh7.Range("A2:A" & lLastRow7A)
                myDictionary.Add CDate(myCell), CDate(myCell)
            Next
        On Error GoTo 0
    
        ReDim Preserve arrData(myDictionary.Count)
        arrData = myDictionary.Items
            SortAr arrData
            CmB_Date.List = arrData                                         'не заполняется комбобокс
            CmB_Date.Value = Format(CmB_Date.Value, "ddd dd.mm.yy h:mm")    'нужен такой формат дат в комбобоксе
End Sub
Sub SortAr(arr() As Date)
    Dim Temp As Date, i As Long, j As Long
        For j = 2 To UBound(arr)
            Temp = arr(j)
            For i = j - 1 To 1 Step -1
                If (arr(i) <= Temp) Then GoTo 10
                    arr(i + 1) = arr(i)
            Next i
            i = 0
10:         arr(i + 1) = Temp
        Next j
End Sub

Sub pict ()
if ToggleButton1 true then
    ToggleButton1.Picture = Pict1
else
    ToggleButton1.Picture = Pict2
end if
end sub

Sub Sorturovka()
    Application.ScreenUpdating = False
    Dim lLastRow As Long
        On Error Resume Next
        ActiveSheet.ShowAllData
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Sort.SortFields.Clear
    Sort.SortFields.Add Key:=Range("B2:B" & lLastRow), SortOn:=xlSortOnValues, _
                                                Order:=xlAscending, DataOption:=xlSortNormal
    Sort.SortFields.Add Key:=Range("A2:A" & lLastRow), SortOn:=xlSortOnValues, _
                                                Order:=xlAscending, DataOption:=xlSortNormal
    
    Sort.SortFields.Add Key:=Range("D2:D" & lLastRow), SortOn:=xlSortOnValues, _
                                                Order:=xlAscending, DataOption:=xlSortNormal ' вместо этого должна быть нестандартная сортировка _________
    
    
    With Sort
        .SetRange Range("A2:E" & lLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub

Sub DellAllName()
   Dim name As Object
    For Each name In ActiveWorkbook.Names
       name.Delete
   Next
End Sub