Получение стоимости драгметаллов с сайта цбр

Пользователь

Сообщений: 173 Регистрация: 04.02.2016

15.05.2023 15:13:41

Добрый день, ув. Форумчане!

Возможно у кого-то есть готовый макрос для получения стоимости драгметаллов на определенную дату с сайта cbr.ru.
Варианты, которые удалось найти в интернете, не работают (
Заранее благодарю!

Alien Sphinx

Пользователь

Сообщений: 2683 Регистрация: 10.01.2023

Excel 365

15.05.2023 15:23:05

Alexey0185,
вот этот запрос PQ вполне себе сносно забирает данные с сайта ЦБ по драгметаллам за период "от" и "до". Меняйте текст строки запроса - получите все, что вам надо.

Код

let
    Source = Web.Page(Web.Contents("https://www.cbr.ru/hd_base/metall/metall_base_new/?UniDbQuery.Posted=True&UniDbQuery.From=01.05.2023&UniDbQuery.To=13.05.2023&UniDbQuery.Gold=true&UniDbQuery.Silver=true&UniDbQuery.Platinum=true&UniDbQuery.Palladium=true&UniDbQuery.so=1")),
    Data2 = Source{2}[Data]
in
    Data2

Пришелец-прораб.

Alexey0185 Пользователь Сообщений: 173 Регистрация: 04.02.2016	#3 15.05.2023 15:27:09 Благодарю, но к сожалению на дворе 2023 год, а PQ пока еще не у всех пользователей.

Тимофеев

Пользователь

Сообщений: 2166 Регистрация: 01.09.2020

15.05.2023 16:23:45

Можете так тогда смотреть

Код

=ЕСЛИОШИБКА(--ПОДСТАВИТЬ(ФИЛЬТР.XML("<a>"&ПСТР(
ВЕБСЛУЖБА("https://www.cbr.ru/hd_base/metall/metall_base_new/?UniDbQuery.Posted=True&UniDbQuery.From="&
ТЕКСТ(B1;"ДД.ММ.ГГГГ")&"&UniDbQuery.To="&ТЕКСТ(B1;"ДД.ММ.ГГГГ")&
"&UniDbQuery.Gold=true&UniDbQuery.Silver=true&UniDbQuery.Platinum=true&UniDbQuery.Palladium=true&UniDbQuery.so=1");
ПОИСК("<td class";
ВЕБСЛУЖБА("https://www.cbr.ru/hd_base/metall/metall_base_new/?UniDbQuery.Posted=True&UniDbQuery.From="&
ТЕКСТ(B1;"ДД.ММ.ГГГГ")&"&UniDbQuery.To="&ТЕКСТ(B1;"ДД.ММ.ГГГГ")&
"&UniDbQuery.Gold=true&UniDbQuery.Silver=true&UniDbQuery.Platinum=true&UniDbQuery.Palladium=true&UniDbQuery.so=1"));
ПОИСК("</tr>";ПСТР(ВЕБСЛУЖБА("https://www.cbr.ru/hd_base/metall/metall_base_new/?UniDbQuery.Posted=True&UniDbQuery.From="&
ТЕКСТ(B1;"ДД.ММ.ГГГГ")&"&UniDbQuery.To="&ТЕКСТ(B1;"ДД.ММ.ГГГГ")&
"&UniDbQuery.Gold=true&UniDbQuery.Silver=true&UniDbQuery.Platinum=true&UniDbQuery.Palladium=true&UniDbQuery.so=1");
ПОИСК("<td class";ВЕБСЛУЖБА("https://www.cbr.ru/hd_base/metall/metall_base_new/?UniDbQuery.Posted=True&UniDbQuery.From="&
ТЕКСТ(B1;"ДД.ММ.ГГГГ")&"&UniDbQuery.To="&ТЕКСТ(B1;"ДД.ММ.ГГГГ")&
"&UniDbQuery.Gold=true&UniDbQuery.Silver=true&UniDbQuery.Platinum=true&UniDbQuery.Palladium=true&UniDbQuery.so=1"));1000))-1)&"</a>";
"//td");",";ПСТР(1/2;2;1));"нет в базе")

Прикрепленные файлы

Металлы.xlsx (10.44 КБ)

Изменено: Тимофеев - 15.05.2023 16:26:03

Alexey0185 Пользователь Сообщений: 173 Регистрация: 04.02.2016	#5 15.05.2023 20:34:34 Благодарю, работает!

Alexey0185 Пользователь Сообщений: 173 Регистрация: 04.02.2016	#6 15.05.2023 20:36:34 Нашел еще такую ветку, но ни одна макрофункция у меня не работает. http://www.excelworld.ru/forum/10-13486-1 Возможно потому что ветка 2014 года (

ZVI

Пользователь

Сообщений: 4609 Регистрация: 23.12.2012

16.05.2023 13:49:16

Добрый день, Алексей.
Используйте код ниже, примеры вызова - см. в комментариях кода

Код

Function CbrMet(Optional OnDate, Optional MetCode = 1) As Double
' ZVI:2023-05-16 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=157620#message1251712
' Цена драгметалла на ЦБР
' Примеры:
' =CbrMet(A1;1)               - цена золота, в A1 дата
' =CbrMet(A1;"au")            - то же самое, допускаются коды: "Au", "Ag", "Pt","Pd"
' =CbrMet(ДАТА(2023;5;14);2)  - цена серебра в воскресенье 14 мая 2023
' =CbrMet(СЕГОДНЯ();2)        - цена серебра сегодня
' =CbrMet(СЕГОДНЯ())          - цена золота сегодня (код 1 по умолчанию)
  Const MetList As String = "au,ag,pt,pd"
  Static oDoc As Object
  Dim i As Long
  If oDoc Is Nothing Then
    Set oDoc = CreateObject("MSXML2.DOMDocument.6.0")
    oDoc.async = False
  End If
  If IsMissing(OnDate) Then OnDate = Date
  If VarType(MetCode) = vbString Then
    i = InStr(MetList, LCase(MetCode))
    If i = 0 Then i = Val(MetCode) Else i = i \ 3 + 1
  Else
    i = MetCode
  End If
  With oDoc
    .Load ("http://www.cbr.ru/scripts/xml_metall.asp?date_req1=" & CDate(OnDate) - 16 & "&date_req2=" & CDate(OnDate))
    CbrMet = Val(Replace(.SelectSingleNode("//Record[@Code='" & i & "'][last()]/Buy").Text, ",", "."))
  End With
End Function

Изменено: ZVI - 17.05.2023 13:48:47

Alexey0185 Пользователь Сообщений: 173 Регистрация: 04.02.2016	#8 17.05.2023 12:34:23 ОГРОМНОЕ СПАСИБО!!! То, что требуется )))

ZVI Пользователь Сообщений: 4609 Регистрация: 23.12.2012	#9 17.05.2023 13:47:31 Рад, что решение устроило, удачи!

Читают тему