=ЕСЛИ(ABS($A$1-СТОЛБЕЦ())>ABS($A$1-СТРОКА());(($A$1-СТОЛБЕЦ())^2-(-1)^(СТОЛБЕЦ()>$A$1)*($A$1-СТОЛБЕЦ()))*4+($A$1-СТОЛБЕЦ())*(-5)^(СТОЛБЕЦ()>$A$1)+1+($A$1-СТРОКА())*(-1)^(СТОЛБЕЦ()>$A$1);(($A$1-СТРОКА())^2-(-1)^(СТРОКА()>$A$1)*($A$1-СТРОКА()))*4+3*(-7/3)^(СТРОКА()>$A$1)*($A$1-СТРОКА())+1+($A$1-СТОЛБЕЦ())*(-1)^(СТРОКА()<$A$1))

comboComments.ListIndex =

    Select Case comboComments.ListIndex

comboComments.ListIndex = -1

Private Sub UserForm_Initialize()
   '   Fill the ComboBoxes
    With comboComments
        .List = Array("Только индикатор", "Скрыть", "Показать")
    End With
    '   Get the current settings
    With Parent
        cbFullScreen = .DisplayFullScreen
        comboComments.ListIndex = .DisplayCommentIndicator + 1
    End With
End Sub
Private Sub comboComments_Change()
    With comboComments
        .SetFocus
        Application.DisplayCommentIndicator = .ListIndex - 1
    End With
End Sub

=ВЫБОР(ОСТАТ(ЗНАК((ABS(СТОЛБЕЦ()-$A$1)-ABS(СТРОКА()-$A$1)))+2;2)+1;4*(СТОЛБЕЦ()-$A$1)^2+ВЫБОР((СТРОКА(B2)<=$A$1)+(СТОЛБЕЦ()<=$A$1)*2+1;2;0;-4;2)*(СТОЛБЕЦ()-$A$1)+1;ЕСЛИ(ABS(СТОЛБЕЦ()-$A$1)>ABS(СТРОКА()-$A$1);ЕСЛИ(СТОЛБЕЦ()<$A$1;B1;B3)-1;ЕСЛИ(СТРОКА(B2)<$A$1;A2;C2)+1))

Selection.NumberFormat = "[$" &chrw(8356) & "-410]#,##0.00_ ;[Red]-[$" &chrw(8356) & "-410]#,##0.00"

Function Похожие$()
    Dim r As Range, r1 As Range, s$
    Set r = Application.Caller
    Select Case True
        Case IsEmpty(r(1, 0)) And Not IsEmpty(r(2, 0))
            Set r1 = r.Parent.Range(r(1, -1), IIf(IsEmpty(r(3, 0)), r(2, 0), r(2, 0).End(xlDown)(1, 0)))
            Похожие = Join(Filter(Application.Transpose(r1), r(1, -1), 0), ";")
        Case Not IsEmpty(r(1, 0))
            s = IIf(IsEmpty(r(2, 0)), ";", "")
            Похожие = r(0, -1) & ";" & Replace(r(0, 1) & s, s & r(1, -1) & ";", "")
    End Select
End Function

=СУММПРОИЗВ((C5:AF5="от")*(ДЕНЬНЕД(C$3:AF$3;2)<6)*8)

=ПРОСМОТР(;-1/ПОИСК("Карта № ";$A$1:A9);$A$1:$A$2)

Function AddSpaces(s$, i%)
    AddSpaces = Join(Split(StrConv(s, 64), Chr(0)), Space(i))
End Function

=ЕСЛИОШИБКА(ПРОСМОТР("яяя";ТЕКСТ(--ПСТР(A2;ПОИСКПОЗ({3;4;5}+1;ЧАСТОТА(СТРОКА($1:$999);ЕОШ(-ПСТР(A2&-(9^6);СТРОКА($1:$999);1))*СТРОКА($1:$999));)-{3;4;5};{3;4;5});ПОВТОР(0;{3;4;5})));"")

=ЕСЛИОШИБКА(ПРОСМОТР("яяя";ТЕКСТ(--ПСТР(A2;ДЛСТР(A2)-ПОИСКПОЗ({3;4;5}+1;ЧАСТОТА(СТРОКА($1:$999);ЕОШ(-ПСТР(A2&-(9^6);ДЛСТР(A2)-СТРОКА($1:$999)+1;1))*СТРОКА($1:$999));)+2;{3;4;5});ПОВТОР(0;{3;4;5})));"")

let
    fx=(FileContents) => let
        fn =(t as table, SheetName as text, optional NeededColumns as nullable list, optional Filter as nullable text, optional ColumnsToRename as nullable list)=>let
            Sheet      = t{[Item=SheetName,Kind="Sheet"]}[Data],
            NeededCol  = if NeededColumns<>null then Table.SelectColumns(Sheet,NeededColumns) else Sheet,
            Filtered   = if Filter<>null then Table.SelectRows(NeededCol, each Expression.Evaluate(Filter,[_=_])) else NeededCol,
            Promoted   = Table.PromoteHeaders(Filtered, [PromoteAllScalars=true]),
            RenameCol  = if ColumnsToRename<>null then Table.RenameColumns(Promoted,ColumnsToRename) else 1,
            FullName   = NeededCol{[Column3="ФИО работника:"]}[Column4],
            AddName    = Table.AddColumn(RenameCol, "ФИО", each FullName)
        in Table.ReorderColumns(AddName,{"ФИО"}&Table.ColumnNames(RenameCol)),
        Мониторинг_КП_ежекв = fn(
            FileContents,
            "Мониторинг КП_ежекв",
            {"Column2", "Column3", "Column4", "Column5", "Column6"},
            "([Column2] <> null) and ([Column4] <> null) and ([Column3] <> ""-"")",
            {{"№#(lf)п.п.", "№ п.п."}}
        ),
        Оценка_проектов_по_году = fn(
            FileContents,
            "Оценка проектов (по году)",
            {"Column2", "Column3", "Column4", "Column5", "Column6", "Column7", "Column8", "Column11", "Column12", "Column18"},
            "([Column3] <> null) and ([Column3] <> ""-"") and ([Column5] <> null) and ([Column3] <> 2)",
            {{"Column5", "Качество балл (факт)"}, {"Column7", "График балл (факт)"}}
        ),
        Columns = {"ФИО", "№ п.п.", "Наименование проекта"},
        Join = Table.NestedJoin(Оценка_проектов_по_году,Columns,Мониторинг_КП_ежекв,Columns,"GetData",JoinKind.LeftOuter)
    in Table.ExpandTableColumn(Join, "GetData", List.Difference(Table.ColumnNames(Мониторинг_КП_ежекв),Table.ColumnNames(Оценка_проектов_по_году))),
    Folder=Table.SelectRows(Folder.Files("D:\x"),each (not [Attributes][NotContentIndexed]) and ([Attributes][Kind]="Excel File"))[[#"Folder Path"],[Name],[Content]],
    Transform = Table.TransformColumns(Folder, {{"Content",each fx(Table.Buffer(Excel.Workbook(_, null, true)))}})
in
    Transform

let
    fx=(FileContents) => let
        fn =(t as table, SheetName as text, optional NeededColumns as nullable list, optional Filter as nullable text, optional ColumnsToRename as nullable list)=>let
            Sheet      = t{[Item=SheetName,Kind="Sheet"]}[Data],
            NeededCol  = if NeededColumns<>null then Table.SelectColumns(Sheet,NeededColumns) else Sheet,
            Filtered   = if Filter<>null then Table.SelectRows(NeededCol, each Expression.Evaluate(Filter,[_=_])) else NeededCol,
            Promoted   = Table.PromoteHeaders(Filtered, [PromoteAllScalars=true]),
            RenameCol  = if ColumnsToRename<>null then List.Accumulate(ColumnsToRename,Promoted,(a,b)=>try Table.RenameColumns(a,b) otherwise a) else Promoted,
            FullName   = NeededCol{[Column3="ФИО работника:"]}[Column4],
            AddName    = Table.AddColumn(RenameCol, "ФИО", each FullName)
        in Table.ReorderColumns(AddName,{"ФИО"}&Table.ColumnNames(RenameCol)),
        Мониторинг_КП_ежекв = fn(
            FileContents,
            "Мониторинг КП_ежекв",
            {"Column2", "Column3", "Column4", "Column5", "Column6"},
            "([Column2] <> null) and ([Column4] <> null) and ([Column3] <> ""-"")"
        ),
        Оценка_проектов_по_году = fn(
            FileContents,
            "Оценка проектов (по году)",
            {"Column2", "Column3", "Column4", "Column5", "Column6", "Column7", "Column8", "Column11", "Column12", "Column18"},
            "([Column3] <> null) and ([Column3] <> ""-"") and ([Column5] <> null) and ([Column3] <> 2)",
            {{"Column5", "Качество балл (факт)"}, {"Column7", "График балл (факт)"}}
        ),
        Columns = List.Transform({Оценка_проектов_по_году,Мониторинг_КП_ежекв},each List.Range(Table.ColumnNames(_),0,3)),
        Join    = Table.NestedJoin(Оценка_проектов_по_году,Columns{0},Мониторинг_КП_ежекв,Columns{1},"GetData",JoinKind.LeftOuter)
    in Table.ExpandTableColumn(Join, "GetData", List.Difference(Table.ColumnNames(Мониторинг_КП_ежекв),Table.ColumnNames(Оценка_проектов_по_году)&List.Combine(Columns))),
    Folder    = Table.SelectRows(Folder.Files("D:\x"),each (not [Attributes][NotContentIndexed]) and ([Attributes][Kind]="Excel File"))[[#"Folder Path"],[Name],[Content]],
    Transform = Table.TransformColumns(Folder, {{"Content",each fx(Table.Buffer(Excel.Workbook(_, null, true)))}})
in
    Transform

Option Explicit

Sub Sorting()
    Dim arr() As Variant, s, maxLevel%, i, j, v, s0$, dic As Object, arr1 As Variant
    Set dic = CreateObject("scripting.dictionary")
    With ActiveSheet.UsedRange.Columns(1)
        ReDim arr(.Rows.Count - 1)
        For Each s In .Value
            j = 0: s0 = "'"
            
            For Each v In Split(Split(s, "_")(0), ".")
                s0 = s0 & Application.Dec2Hex(Val(v), 4)
                j = j + 1
            Next
            
            If j > maxLevel Then
                maxLevel = j
            Else
                ShiftLeft s0, maxLevel - j
            End If
            
            If Not IsArray(dic(maxLevel)) Then
                dic(maxLevel) = Array(i)
            Else
                arr1 = dic(maxLevel)
                ReDim Preserve arr1(UBound(arr1) + 1)
                arr1(UBound(arr1)) = i
                dic(maxLevel) = arr1
            End If
            
            arr(i) = Array(s0, s)
            i = i + 1
        Next
        
        For j = maxLevel - 1 To 1 Step -1
            If IsArray(dic(j)) Then
                For Each i In dic(j)
                    ShiftLeft arr(i)(0), maxLevel - j
                Next
            End If
        Next
        Quicksort arr, 0, UBound(arr)

        .Value = Application.Index(arr, 0, 2)
    End With
End Sub
Private Sub ShiftLeft(ByRef s, n)
    s = s & Application.Rept("0000", n)
End Sub

Private Sub Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
    'Sorts a one-dimensional VBA array from smallest to largest
    'using a very fast quicksort algorithm variant.
    Dim pivotVal As Variant
    Dim vSwap    As Variant
    Dim tmpLow   As Long
    Dim tmpHi    As Long

    tmpLow = arrLbound
    tmpHi = arrUbound
    pivotVal = vArray((arrLbound + arrUbound) \ 2)(0)

    While (tmpLow <= tmpHi) 'divide
        While (vArray(tmpLow)(0) < pivotVal And tmpLow < arrUbound)
            tmpLow = tmpLow + 1
        Wend
  
        While (pivotVal < vArray(tmpHi)(0) And tmpHi > arrLbound)
            tmpHi = tmpHi - 1
        Wend

        If (tmpLow <= tmpHi) Then
            vSwap = vArray(tmpLow)
            vArray(tmpLow) = vArray(tmpHi)
            vArray(tmpHi) = vSwap
            tmpLow = tmpLow + 1
            tmpHi = tmpHi - 1
        End If
    Wend

    If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi 'conquer
    If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound 'conquer
End Sub

    For a = b To c Step d
       DoEvents
    Next

(c > b) Imp (d < 0)

For i=0 To 0:?i:Next:?i