Забыли пароль?


Хитрости »
Основные понятия (24)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (17)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (66)
Разное (42)
Баги и глюки Excel (4)

Получить ключевую ставку ЦБ РФ через VBA и Power Qwery

Для расчета задолженности за просроченные платежи по зарплате, за поставку товаров, да и для множества других ситуаций, связанный с начислением пени, используется ключевая ставка ЦентроБанка РФ(если в договоре такие моменты не оговариваются установлением фиксированной ставки за день или год). Сам размер ключевой ставки устанавливается непосредственно ЦентроБанком и может изменяться от двух раз в год и более. В связи с этим рассчитывать задолженность становится сложнее, т.к. надо учитывать и изменения ключевой ставки за расчетный период. Данные по размеру ключевой ставки в открытом доступе выложены на сайте ЦБ: https://www.cbr.ru/hd_base/KeyRate/
там можно выбрать период ставки и посмотреть как она изменялась.


Примечание: ЦБ может изменять структуру сайта самостоятельно и без уведомлений, поэтому решения могут не работать в какой-то момент до тех пор, пока я не увижу, что были изменения и не исправлю коды



 

Как получить ставку на дату при помощи функции в Visual Basic for Application
Лучше всего использовать UDF(функцию пользователя), чтобы можно было применить как из листа, так и внутри других кодов:

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: Получение ключевой ставки
'---------------------------------------------------------------------------------------
Function Get_KeyRate(Optional ByVal dt As Date)
    Dim res, response As String
    Dim oXMLHTTP As Object
    Dim lp As Long, le As Long
    Dim sdt As String, sfnd As String
    'определяем дату
    If dt = 0 Or dt > Date Then
        dt = Date
    End If
    sdt = Format(dt, "dd.MM.yyyy")
    'пробуем подключиться к сайту
    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    If oXMLHTTP Is Nothing Then
        'не доступна библиотека для подключения к интернет странице
        Exit Function
    End If
    With oXMLHTTP
        'отправляем запрос на сайт
        .Open "GET", "https://www.cbr.ru/hd_base/KeyRate/?UniDbQuery.Posted=True&UniDbQuery.From=" & sdt & "&UniDbQuery.To=" & sdt, False
        .send
        'ждем пока вся страница загрузится
        Do While .readyState <> 4
          DoEvents
        Loop
        'получаем код страницы
        response = .responseText
    End With
    On Error GoTo 0
    'если запрос прошел успешно
    If Len(response) Then
        response = LCase(Trim(Replace(Replace(response, vbNewLine, ""), " ", "")))
        'обозначаем искомый текст внутри кода страницы - это блок с указанием даты и ставки
        sfnd = "<th>ставка</th></tr><tr><td>" & sdt & "</td><td>"
        'определяем позицию в странице, где указывается ставка
        lp = InStr(1, response, sfnd, 1)
        If lp > 0 Then
            'определяем позицию в странице, где заканчивается блок с размером ставки
            le = InStr(lp + Len(sfnd), response, "</td>", 1)
            'вырезаем на основании полученных позиций размер ставки
            res = Mid(response, lp + Len(sfnd), le - lp - Len(sfnd))
        End If
    End If
    'приводим текствое представление ставки "6,00" в числовое
    res = Val(Replace(Replace(res, " ", ""), ",", "."))
    'возвращаем результат
    Get_KeyRate = res / 100
End Function

Чтобы правильно использовать приведенный код, необходимо сначала ознакомиться со статьей Что такое функция пользователя(UDF)?. Вкратце: скопировать текст кода выше, перейти в редактор VBA(Alt+F11) -создать стандартный модуль(Insert -Module) и в него вставить скопированный текст. После чего функцию можно будет вызвать из Диспетчера функций(Shift+F3), отыскав её в категории Определенные пользователем (User Defined Functions).
Но здесь есть один существенный минус: сайт ЦБ возвращает ставку только на будние дни - для праздничных дней функция будет возвращать 0, что не очень удобно. Как быть? Я решил написать еще одну функцию - которая просто берет указанную дату, и если ставка на неё возвращается 0, то отнимаем от этой даты по 1 дню до тех пор, пока не получим размер ставки. Т.е. от указанной даты мы идем назад до первого буднего дня, т.к. для выходных ставка остается той, которая была назначена в последний рабочий день:

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: Получение ключевой ставки
'---------------------------------------------------------------------------------------
Option Explicit
 
Function GetLastAllowRate(Optional ByVal dt As Date)
    Dim res, lcnt As Long
    'пробуем получить ставку на указанную дату
    res = Get_KeyRate(dt)
    'если ставка равна 0 - значит на эту дату её не опубликовали
    '   скорее всего это выходной день
    '   поэтому пробуем получить ставку на ранние даты
    '   уменьшая исходную дату на 1 пока не получим ставку
    Do While res = 0
        lcnt = lcnt + 1
        'вызываем функцию получения ставки на заданную дату
        res = Get_KeyRate(dt - lcnt)
        'если пропустили более 30 дней - завершаем
        'т.к. скорее всего проблема с сервисом
        If lcnt > 30 Then
            Exit Do
        End If
    Loop
    GetLastAllowRate = res
End Function

Сама функция работает в паре с приведенной ранее функцией Get_KeyRate, циклично вызывая её для каждой даты.



 
Как получить ставку на дату при помощи Power Qwery

Прежде чем читать далее и пробовать применить, необходимо знать азы работы в Power Query(Power Query - что такое и почему её необходимо использовать в работе?), уметь создавать и редактировать запросы и вызвать расширенный редактор: переходим в нужный запрос -Главная -Расширенный редактор:
Расширенный редактор

Получить ключевую ставку через Power Qwery еще проще, т.к. можно задать сразу период дат, на которые необходимы ставки и все. Она сама определит таблицу и её надо будет только вывести на лист. Например, мы хотим получить все ставки за период с 01.01.2020 по 22.02.2020. На сайте https://www.cbr.ru/hd_base/KeyRate/ выбираем нужный период и смотрим какая ссылка в строке адреса в браузере у нас в итоге получилась:
https://www.cbr.ru/hd_base/KeyRate/?UniDbQuery.Posted=True&UniDbQuery.FromDate=01.01.2020&UniDbQuery.ToDate=22.02.2020
Её и будем использовать в Power Qwery. Идем на вкладку Данные(Data) или Power Query -группа Скачать и преобразовать(Get & Transform) -Получить данные(Get Data) -Из других источников(From other source) -Из интернета(From Web). В появившемся окне вставляем нашу ссылку и жмем Ок:
Получить данные из интернета Power Qwery
В следующем окне выбираем Table0 и в предпросмотре уже видим результат.
Результат получения ключевой ставки из Power Qwery
Остается нажать на кнопку внизу Загрузить, после чего выбранная таблица будет выгружена на новый лист Excel. Все, список готов.
Сам запрос в расширенном редакторе выглядит так:

let
    Источник = Web.Page(Web.Contents("https://www.cbr.ru/hd_base/KeyRate/?UniDbQuery.Posted=True&UniDbQuery.From=01.01.2020&UniDbQuery.To=22.02.2020")),
    Data0 = Источник{0}[Data],
    #"Измененный тип" = Table.TransformColumnTypes(Data0,{{"Дата", type date}, {"Ставка", type number}})
in
    #"Измененный тип"

Остается две проблемы:

  1. Даты не обновляются сами
    Хотелось бы, чтобы даты периода можно было бы задавать на листе Excel и просто обновлять потом запрос, не открывая сам запрос в Расширенном редакторе каждый раз для изменений. Например, в одной ячейке записать 01.01.2020, а во второй формулу СЕГОДНЯ(TODAY), чтобы обновлять список ежедневно. Здесь тоже все решаемо - я уже показывал в статье Относительный путь к данным PowerQuery как можно создать переменные для запроса на листе Excel. А в статье Курс валют при помощи Power Query можно почитать и посмотреть как сделать изменяемые периоды и как это работает. Повторяться не буду, т.к. в озвученных статьях все расписано от и до, а к данной статье приложен пример с запросом именно через заданные в ячейках даты. Если взять простую реализацию запроса, то выглядеть он будет так:

    let
        sd1 = DateTime.ToText(Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата1],"dd.MM.yyyy"),
        sd2 = DateTime.ToText(Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата2],"dd.MM.yyyy"),
        Источник = Web.Page(Web.Contents("https://www.cbr.ru/hd_base/KeyRate/?UniDbQuery.Posted=True&UniDbQuery.FromDate=" & sd1 & "&UniDbQuery.ToDate=" & sd2)),
        Data0 = Источник{0}[Data],
        #"Измененный тип" = Table.TransformColumnTypes(Data0,{{"Дата", type date}, {"Ставка", type number}})
    in
        #"Измененный тип"

    Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата1] - это ссылка на ячейки умной таблицы params, где записана начальная дата
    Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата2] - это ссылка на ячейки умной таблицы params, где записана конечная дата

  2. В таблице присутствуют не все даты, а только будничные(т.е. праздники и выходные просто отсутствуют). А при расчете задолженности эти дни так же надо учитывать. Здесь уже все сложнее, т.к. никакими параметрами на листе нам этого не добиться. Нет, можно, конечно, формулами массива создавать список дат от и до и на него ориентироваться, но...Не лучший это вариант и раз уж мы все равно все делаем на Power Qwery - то сделаем этот список внутри. Поможет нам в этом универсальная и мощная функция List.Generate, которая может создавать списки практически для любых задач. Нам она нужна для того, чтобы взять начальную и конечные даты и создать список дат между ними без всяких пропусков. По сути сам текст функции создания списка дат будет таким:
    l_dates = List.Generate(
        //создаем запись с условиями: начальный элемент и начальная позиция в списке
        ()=> [i = 0, dt = dt1],
        //условие завершения цикла: если текущее значение(dt) меньше равно последней дате 
        each [dt] <= dt2,
        //увеличиваем счетчик на 1 и создаем следующий элемент списка, прибавляя к предыдущему 1 день
        each [i = [i] + 1, dt = Date.AddDays([dt],1)],
        //показываем что именно выводить в будущий список
        each [dt]
    ),

    Однако одного этого мало. После того, как этот список создан, надо для каждой его даты записать ключевую ставку(её мы будем брать из полученной ранее таблицы с сайта) и заполнить пропущенные даты значениями ставки из предыдущей даты. Чтобы записать ставку из одной таблицы в другую используем инструмент объединить запросы. Правда, т.к. второго запроса у нас как такового нет, то мы просто берем две таблицы и объединяем их по ключу(Table.NestedJoin). Потом сортируем по дате по возрастанию(т.к. после объединения даты могут идти не по порядку и следующим шагом можем получить неверную ставку) и заполняем при помощи заполнения(вкладка Преобразование(Transform) -Заполнить(Fill) -Вниз(Down)) ставки значениями предыдущих дат.

Итоговый запрос выглядит так - я постарался каждый шаг расписать для понимания происходящего внутри:

let
    //определяем начальную и конечные даты
    dt1 = Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата1],
    dt2 = Excel.CurrentWorkbook(){[Name="params"]}[Content]{0}[Дата2],
    sd1 = DateTime.ToText(dt1,"dd.MM.yyyy"),
    sd2 = DateTime.ToText(dt2,"dd.MM.yyyy"),
    //получаем таблицу ставок за период
    Источник = Web.Page(Web.Contents("https://www.cbr.ru/hd_base/KeyRate/?UniDbQuery.Posted=True&UniDbQuery.From=" & sd1 & "&UniDbQuery.To=" & sd2)),
    //изменяем тип столбца Дата в таблице с текстового на дата
    Data0 = Table.TransformColumnTypes(Источник{2}[Data],{{"Дата", type date}}),
    //создаем список непрерывных дат от начальной до конечной
    l_dates = List.Generate(
            //создаем запись с условиями: начальный элемент и начальная позиция в списке
            ()=> [i = 0, dt = dt1],
            //условие завершения цикла: если текущее значение(dt) меньше равно последней дате 
            each [dt] <= dt2,
            //увеличиваем счетчик на 1 и создаем следующий элемент списка, прибавляя к предыдущему 1 день
            each [i = [i] + 1, dt = Date.AddDays([dt],1)],
            //показываем что именно выводить в будущий список
            each [dt]
            ),
    //преобразуем список в таблицу, чтобы использовать возможность объединения таблиц
    res_table = Table.FromList(l_dates, Splitter.SplitByNothing(), {"Дата"}, null),
    //перед объединением приводим тип столбца Дата на Дата, чтобы они были одинаковые в обеих таблицах
    dt_table = Table.TransformColumnTypes(res_table,{{"Дата", type date}}),
    //объединяем по столбцу Дата таблицу полных дат и таблицу ставок
    join_tbl = Table.NestedJoin(dt_table, {"Дата"}, Data0, {"Дата"}, "Ставка", JoinKind.LeftOuter),
    add_rate = Table.ExpandTableColumn(join_tbl, "Ставка", {"Ставка"}, {"Ставка"}),
    //сортируем таблицу по возрастанию дат, т.к. после объединения она может быть не упорядочена
    tbl_sort = Table.Sort(add_rate,{{"Дата", Order.Ascending}}),
    //заполняем все пропущенные даты значениями предыдущих дат
    fill_down = Table.FillDown(tbl_sort,{"Ставка"}),
    //назначаем Числовой тип столбцу со ставками
    rate_type = Table.TransformColumnTypes(fill_down,{{"Ставка", type number}})
in
    rate_type

В нем и даты берутся из ячеек и нет пропусков дат. И именно в таком виде запрос приложен к статье в файле.

Скачать файл:

  Ключевая ставка в VBA и PowerQuery.xlsm (52,7 KiB, 113 скачиваний)

Так же см.:
Получить данные из файлов XML при помощи Power Query
Объединение(слияние) запросов при помощи PowerQuery
Относительный путь к данным PowerQuery
Вычисления в PowerQuery
Курс валют при помощи Power Query
Производственный календарь в Excel (VBA и Power Qwery)
Получить курс валют от ЦБР


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки
Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2020 Excel для всех   Войти