Получить ключевую ставку ЦБ РФ через VBA и Power Qwery
Для расчета задолженности за просроченные платежи по зарплате, за поставку товаров, да и для множества других ситуаций, связанный с начислением пени, используется ключевая ставка ЦентроБанка РФ(если в договоре такие моменты не оговариваются установлением фиксированной ставки за день или год). Сам размер ключевой ставки устанавливается непосредственно ЦентроБанком и может изменяться от двух раз в год и более. В связи с этим рассчитывать задолженность становится сложнее, т.к. надо учитывать и изменения ключевой ставки за расчетный период. Данные по размеру ключевой ставки в открытом доступе выложены на сайте ЦБ: https://www.cbr.ru/hd_base/KeyRate/
там можно выбрать период ставки и посмотреть как она изменялась.
- Как получить ставку на дату при помощи функции в Visual Basic for Application
- Как получить ставку на дату при помощи Power Qwery
Примечание: ЦБ может изменять структуру сайта самостоятельно и без уведомлений, поэтому решения могут не работать в какой-то момент до тех пор, пока я не увижу, что были изменения и не исправлю коды
Лучше всего использовать 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(
Но здесь есть один существенный минус: сайт ЦБ возвращает ставку только на будние дни - для праздничных дней функция будет возвращать 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 |
Сама функция работает в паре с приведенной ранее функцией
Прежде чем читать далее и пробовать применить, необходимо знать азы работы в Power Query(Power Query - что такое и почему её необходимо использовать в работе?), уметь создавать и редактировать запросы и вызвать расширенный редактор: переходим в нужный запрос -Главная -Расширенный редактор:
Получить ключевую ставку через Power Qwery еще проще, т.к. можно задать сразу период дат, на которые необходимы ставки и все. Она сама определит таблицу и её надо будет только вывести на лист. Например, мы хотим получить все ставки за период с 01.01.2020 по 22.02.2020. На сайте https://www.cbr.ru/hd_base/KeyRate/ выбираем нужный период и смотрим какая ссылка в строке адреса в браузере у нас в итоге получилась:
Её и будем использовать в Power Qwery. Идем на вкладку Данные
В следующем окне выбираем Table0 и в предпросмотре уже видим результат.
Остается нажать на кнопку внизу Загрузить, после чего выбранная таблица будет выгружена на новый лист 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
#"Измененный тип" |
Остается две проблемы:
Даты не обновляются сами
Хотелось бы, чтобы даты периода можно было бы задавать на листе Excel и просто обновлять потом запрос, не открывая сам запрос в Расширенном редакторе каждый раз для изменений. Например, в одной ячейке записать 01.01.2020, а во второй формулуСЕГОДНЯ , чтобы обновлять список ежедневно. Здесь тоже все решаемо - я уже показывал в статье Относительный путь к данным PowerQuery как можно создать переменные для запроса на листе Excel. А в статье Курс валют при помощи Power Query можно почитать и посмотреть как сделать изменяемые периоды и как это работает. Повторяться не буду, т.к. в озвученных статьях все расписано от и до, а к данной статье приложен пример с запросом именно через заданные в ячейках даты. Если взять простую реализацию запроса, то выглядеть он будет так:(TODAY) 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, где записана конечная датаВ таблице присутствуют не все даты , а только будничные(т.е. праздники и выходные просто отсутствуют). А при расчете задолженности эти дни так же надо учитывать. Здесь уже все сложнее, т.к. никакими параметрами на листе нам этого не добиться. Нет, можно, конечно, формулами массива создавать список дат от и до и на него ориентироваться, но...Не лучший это вариант и раз уж мы все равно все делаем на 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, 604 скачиваний)
Так же см.:
Получить данные из файлов XML при помощи Power Query
Объединение(слияние) запросов при помощи PowerQuery
Относительный путь к данным PowerQuery
Вычисления в PowerQuery
Курс валют при помощи Power Query
Производственный календарь в Excel (VBA и Power Qwery)
Получить курс валют от ЦБР
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
