Function SortDescending(arr As Variant, col_index As Long)

    Dim i As Long
    Dim j As Long
    Dim temp As Variant

    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            If arr(j, col_index) > arr(i, col_index) Then
                temp = arr(i, 0)
                arr(i, 0) = arr(j, 0)
                arr(j, 0) = temp
                
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp
            End If
        Next j
    Next i

End Function

Sub HighlightNumericPartInColumn()
    Dim i As Long
    Dim lastRow As Long
    Dim regex As Object
    Dim match As Object
    Dim cellValue As String
    
    Set regex = CreateObject("vbscript.regexp")
    regex.Pattern = "\d+" ' ищем все последовательности цифр
    
    lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row ' определение последней заполненной строки в столбце A
    
    For i = 1 To lastRow
        cellValue = ActiveSheet.Cells(i, "A").Value ' читаем значение ячейки в строке i
        Set match = regex.Execute(cellValue) ' ищем все соответствия регулярному выражению
        For Each m In match ' проходимся по всем найденным соответствиям
            ActiveSheet.Cells(i, "A").Characters(m.FirstIndex + 1, m.Length).Font.Color = vbRed ' изменяем цвет шрифта только для найденной последовательности цифр
        Next m
    Next i
End Sub

Private Sub Auto_Open()

    Dim answer      As Integer

    Name_CMP = ThisWorkbook.Name
    answer = MsgBox("Начинаем формировать новый документ?", vbQuestion + vbYesNo + vbDefaultButton2, "Назови цель!")

    If answer = vbYes Then
        MsgBox "Погнали"
        Application.ScreenUpdating = False    'отключаем обновление экрана
        Application.Calculation = xlCalculationManual        'Отключаем автопересчет формул
        Application.EnableEvents = False        'Отключаем отслеживание событий
        ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False        'Отключаем разбиение на печатные страницы

        Call DownloadIndex
        Call stoks_transfer_to_model
        Call loop_atr
        Call Get_Links_Open_files 'этот макрос открываем все книги в связях, а их 8 штук. это необходимо для нормальной работы исходной книги
        Workbooks(Name_CMP).Activate
        Call add_row
    Else
        MsgBox "Ок, просто посмотреть, понял"
    End If

End Sub

        Workbooks(Name_CMP).Activate
        Call add_row

Dim Массив As Variant, i As Long
    Массив = Range("A1:A10").Value
    For i = 1 To UBound(Массив)
     If Массив(i, 1) = КакаяТоИнфа Then
     End If
    Next i

cells(1,1).formula = "forecast.ets(" & finalddate & "A1:A3;B1:B3)"

Option Compare Database
Option Explicit
Public Sub test()
    Dim app As Excel.Application
    Set app = New Excel.Application
    Debug.Print app.Evaluate("FORECAST.ETS(42125,{1,2,3,4},{42005,42036,42064,42095})")
    app.Quit
End Sub

For i = 9 To 1000
        If Range("A" & i) = data_nachalo Then
            a = a + Range("b" & i) * Range("c" & i)
            b = b + Range("b" & i)
        End If
    Next i
 c = a / b

ЛИНЕЙН(B1:B5;A1:A5)

Date_cell = Workbooks(fileName).Worksheets("тест").Range("N5").Address    'тут написано "Выпуск от 05 Январь 2023 г."
            Workbooks(fileName).Worksheets("тест").Range(Date_cell).Replace What:="Выпуск от ", Replacement:=""    '
            Workbooks(fileName).Worksheets("тест").Range(Date_cell).Replace What:=" г.", Replacement:="" 
            Workbooks(fileName).Worksheets("тест").Range(Date_cell) = Format(Range(Date_cell).Value, "dd/mm/yyyy")    'задаем нормальный формат

Set ws = Лист20    'Имя листа с которого берутся данные. Изменить при изменении

Sub chi()
    Dim ArraySheets() As String
    Dim x           As Variant
    For Each curSheet In ActiveWorkbook.Worksheets

        If curSheet.Name Like "*С месяца *" Then
            ReDim Preserve ArraySheets(x)
            ArraySheets(x) = curSheet.Name
            x = x + 1
        End If
    Next curSheet
    
End Sub

    NumberOfDays = InputBox("Сколько дней заполнить?") 

Лист1.ShowAllData

On Error Resume Next
Лист1.ShowAllData

k = Cells(i, FactValue).Value
Cells(i, FactValue).Formula = "=(" & k & "/1.2)/курс"

    With Worksheets("Справочник")
        Kniga = .Cells(2, 52).Text
        GetObject (Kniga)
    End With

    With Worksheets("Справочник")
       FileToClose = .Cells(2, 52).Text
       Workbooks(FileToClose).Close
    End With

    With Worksheets("Лист1")
        NachaloKopirovaniya = .Range("a2:DD2").Find("начало").Column 'начало копирования
        KonetcKopirovaniya = .Range("a2:DD2").Find("конец").Column' конец копирования
        lLastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1'последняя ячейка
        Range(Cells(2, NachaloKopirovaniya), Cells(lLastRow, KonetcKopirovaniya)).Offset(0, 9) = Range(Cells(2, NachaloKopirovaniya), Cells(lLastRow, KonetcKopirovaniya)).Value 'приравниваем значения
    End With

Price= Range("A7:DD8").Find("Цена", SearchOrder:=xlRows).Column

currentPrice = Split(Cells(1, Price).Address(True, False), "$")(0)

For i = 1 To 5
        On Error Resume Next
        If Cells(i, previousPrice).Value = "new" Then    'в каком столбике ищем обозначение новой строки
            Cells(i, previousCost).Formula = "=bf" & i    'вот как тут использовать найденные буквы?
        End If
    Next i

With Workbooks(WBName).Worksheets(WBList)   
        vVALs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2  
        For v = LBound(vVALs, 1) To UBound(vVALs, 1)   
            dict.Item((vVALs(v, 1))) = vVALs(v, 1)
        Next v
    End With