Макрос (функция) для получения курса валют с сайта ЦБ РФ

Добрый день!
Макрос не работает на Mac почему-то.
В ячейках, где должны быть курсы, просто стоят нули.
Может можно как-то подправить под Mac?

Добрый день! Обнаружил, что функция по разному отрабатывает в зависимости от региональных настроек установленных на компьютере. Работаю с настройками United States. Такое ощущение, что функция по разному обрабатывает знак разделителя дробной части. В русских настройках это запятая, а в американских точка. Можно это поправить как-то?

Используется в виде надстройки курсы.xlam. формула =GetRate(P2;N3) в одной ячейке (в двух ячейках для двух валют). в третьей ячейке формула =СЕГОДНЯ(). Речь идет о работе на удаленном рабочем столе в корпоративной сети. Надстройка включена на двух компах

Поставил данный макрос и всё работает нормально. Но почему-то через какое-то время (дня 2-3) он начинает сильно грузить эксель. Формулы считаются с задержкой, при внесении данных в ячейки в строке состояния появляется сообщение "Расчёт 4 процессор(ы) 98%" или любая другая цифра процентов. А периодически эксель вообще подвисает до состояния "не отвечает". Иногда за день такое бывает пару раз, иногда прям чуть ли не по часу виснет и тормозит. Удаляешь макрос из файла - эксель просто летает.
Помогите, пожалуйста, сам не могу понять, почему такое может быть?

Поставил данный макрос и всё работает нормально. Но почему-то через какое-то время (дня 2-3) он начинает сильно грузить эксель. Формулы считаются с задержкой, при внесении данных в ячейки в строке состояния появляется сообщение "Расчёт 4 процессор(ы) 98%" или любая другая цифра процентов. А периодически эксель вообще подвисает до состояния "не отвечает". Иногда за день такое бывает пару раз, иногда прям чуть ли не по часу виснет и тормозит. Удаляешь макрос из файла - эксель просто летает.
Помогите, пожалуйста, сам не могу понять, почему такое может быть?

Добрый день.
Помогите пожалуйста преобразовать данный макрос для сайта ЕЦБ, интересует как правило отношение EUR к USD.
https://www.ecb.europa.eu/stats/policy_and_exchange_rates/euro_reference...
Большое спасибо!!!! :*

Добрый день, сколько будет стоить сделать парсер, для вывода на сайт онлайн курса на золото и серебро в EUR за 1 гр.?
С сайта:
https://www.goldbroker.com/charts/gold-price/eur
https://www.goldbroker.com/charts/silver-price/eur

Добрый день!
Может мне кто-нибудь помочь, посмотреть, почему не работает код?
Function КурсНБРБ(Optional ТипВалюты As String, Optional ByVal Дата As String) As Double

Application.Volatile True
Dim sRequest As String, sReqRes As String, sRes As String
Dim sDay As String, sMonth As String, sYear As String
Dim lPos As Long, lLastPos As Long, lDel As Long, oHttp
If IsMissing(ТипВалюты) Or ТипВалюты = "" Then ТипВалюты = "EUR"
If IsMissing(Дата) Or Дата = "" Then Дата = Now
If Not IsDate(Дата) Then Дата = CDate(Дата)
sDay = Format(Дата, "dd"): sMonth = Format(Дата, "mm"): sYear = Format(Дата, "yyyy")
sRequest = "http://www.nbrb.by/Services/XmlExRates.aspx C_month=" & sMonth & "&C_year=" & sYear & "&date_req=" & sDay & "%2F" & _
sMonth & "%2F" & sYear
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
If oHttp Is Nothing Then Exit Function
oHttp.Open "GET", sRequest, False
oHttp.Send
sReqRes = oHttp.responseText
lPos = InStr(1, sReqRes, UCase(ТипВалюты), 1)
lPos = InStr(lPos, sReqRes, "", 1) + 4
lLastPos = InStr(lPos, sReqRes, "", 1)
lDel = Mid(sReqRes, lPos, lLastPos - lPos)
lPos = lLastPos + 10
lPos = InStr(lPos, sReqRes, "", 1) + 4
lLastPos = InStr(lPos, sReqRes, "", 1) - 7
sRes = Mid(sReqRes, lPos, 7)
sRes = sRes / lDel
Set oHttp = Nothing
sRes = Replace(sRes, ",", Mid(1 / 2, 2, 1))
КурсНБРБ = sRes
End Function

Здравствуйте Игорь возможно ли эту функцию подогнать под этого сайта http://nbt.tj/tj/kurs/kurs.php и как сделать Спасибо

Игорь, огромное Вам спасибо.
Все прекрасно работает, попробовал пока вставить USD в прайс.
По примерам все легко и просто, первый раз делал такое.
Буду почитывать Ваш сайт :)

Здравствуйте! Подскажите, кто знает, как написать макрос для "вытягивания" курса драгоценных металлов с сайта ЦБ РФ, например для золота. Вот, что у меня получилось, но не работает.
Sub GetZoloto()
Dim xmldoc, nodeList
On Error Resume Next
Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
'пример URL http://www.cbr.ru/scripts/xml_metall.asp?date_req1=14/02/2016&date_req2=...
If Not xmldoc.Load("http://www.cbr.ru/scripts/xml_metall.asp?date_req1=" & _
Format(InputBox("Введите начальную дату поиска в формате ДД.ММ.ГГГГ", "Курс Золота", Date), "dd\/mm\/yyyy") & _
"&date_req2=" & _
Format(InputBox("Введите конечную дату поиска в формате ДД.ММ.ГГГГ", "Курс Золота", Date), "dd\/mm\/yyyy")) Then Exit Sub
Set nodeList = xmldoc.SelectNodes("//Record[@Code='1']")
If nodeList.Length Then ActiveCell.Value = CDbl(nodeList.Item(0).ChildNodes(4).Text)
End Sub
И второй вопрос, как в этом макросе сделать MsgBox с выводом получившегося URL для проверки?
Спасибо всем, за любой ответ.

Курс евро на 1/31/2016 вытаскивает как 819077 (т.е. надо поделить на 10 000). Видимо указатель делителя на сайте цб изменился?

Очень нужен данный макрос GetRate для работы :)
Но, заметил, что данные курса (в частности используються валюты доллар и гривна) не обновляються постоянно). Как можно доработать этот макрос, чтобы все данные курсов обновлялись как при "Получении внешних данных" либо при открытии файла, либо принудительно с заданным интервалом времени. А еще лучше оба варианта. Обновление до актуального курса происходит только при нажатии на ячейке клавиш F2 и Enter.
PS В VBA - полный ноль, так что сам это реализовать/написать не смогу. Поэтому прошу помощи у знающих :)
PPS А еще если бы кто-то адаптировал так же данный макрос по Нацбанк Украины, но я знаю что у них нет своего API для прямого парсинга курсов...

Спасибо за информацию! а тем кто пытается умничать - пусть идут лесом

Скажу больше, курс банка, что отображается в яндексе, это чисто информативно, он нам не полезен в жизни. Нам интересен курс продажи и покупки, а он отличается, именно с этими цифрами нам приходиться иметь дело. Я товар закупаю за доллары и продаю за рубли, соответственно мне доллары надо купить. Курс банка получается не интересен, новости я так смотрю.
Просим автора усовершенствовать фукцию

заглавная яндекса http://www.yandex.ru/
После 11-30 выкладывают курс на завтра. Отоброжается 2 курса (текущий и курс на момент конца торгов, т.е. завтрашний):
сегодня завтра
USD ЦБ 47,0294 −0,3247 46,7047
До 11-30 отображается только текущий.
Дело в следующем: когда видно что курс на момент торгов сильно превышает текущий, продажи импортного товара обычно уже ведутся по завтрашнему курсу. А ваша формула позволяет подставлять автоматически значения только текущего курса.

Сейчас крайне актуален не курс на сегоднящний день, а курс на момент окончания торгов (Яндекс выкладывает его как курс на завтрашний день в 11:30). Не подскажете как взять его с сайта ЦБ РФ? Что изменить в макросе и функции?

Выдаёт 0
Загрузил макрос. В поле вписал код валюты и дату. Может дату как текст надо вписывать ?

НЕ РАБОТАЕТ

Игорь, если выбросить лишнее, то для USD можно сделать функцию:
Function GetUSD(Optional ByVal MyDate As Date) As Double
Dim xmldoc, nodeList
If MyDate = 0 Then MyDate = Date
On Error Resume Next
Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
If Not xmldoc.Load("http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & Format(MyDate, "dd\/mm\/yyyy")) Then Exit Function
Set nodeList = xmldoc.SelectNodes("//Valute[@ID='R01235']")
If nodeList.Length Then GetUSD = CDbl(nodeList.Item(0).ChildNodes(4).Text)
End Function

В коде функции, на мой взгляд, лишние две строчки:
Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
Зачем они? node_attr ни где не используется да и strDate тоже

Не могли бы вы подсказат почему моя функция работает хорошо, когда я применяю её к одной ячейке, но когда я пытаюсь применить эту функцию для нескольких ячеек одновременно, она возвращает "0" для некоторых ячеек.

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double
On Error Resume Next
CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
Set xmlDoc = CreateObject("Msxml.DOMDocument"): xmlDoc.async = False
url_request = "http://cbar.az/currencies/" & Format(RateDate, "dd\.mm\.yyyy") & ".xml"

If xmlDoc.Load(url_request) <> True Then Exit Function

Set nodeList = xmlDoc.SelectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
Set nodeList = xmlDoc.SelectNodes("*/ValType/Valute")
For i = 0 To nodeList.Length - 1
Set xmlNode = nodeList.Item(i).CloneNode(True)
If nodeList.Item(i).Attributes.getNamedItem("Code").Text = CurrencyName Then
CurrencyRate1 = (xmlNode.ChildNodes(2).Text)
CurrencyRate = CDbl(Replace(CurrencyRate1, ".", Application.International(xlDecimalSeparator)))
divisor = Val(xmlNode.ChildNodes(0).Text)
GetRate = CurrencyRate / divisor
Exit Function
End If
Next
End Function

Сегодня (13.06.13) перестал корректно работать макрос. Вместо курсов по некоторым валютам и датам отображает нули, причем скачал пример из этого поста, там тоже самое..

To:
#5Гость, 15 Апр 2013 - 12:12.
мне кажется что не работает на USD , всегда показываешь 7,993 .как исправить ?
а так вообще супер просто .

Усьо работает, просто курс 7.993 долго держится... возьми, например, дату год назад...

Я это комментировал , что не работает USD с НБУ.
> Есть готовая UDF функция для импорта курсов валют с сайта НБУ

Заметил интересную особенность. Иногда отображает курс ЕВРО (на остальных не проверял) на будущую дату

Дата: 06.05.2013 - Курс ЕВРО: 40,5132
Дата: 09.05.2013 - Курс ЕВРО: 40,5132

,а иногда - нет

Дата: 18.05.2013 - Курс ЕВРО: 0,0000
Дата: 20.05.2013 - Курс ЕВРО: 0,0000

Но, видимо, это недочет со стороны сайта cbr.ru.

мне кажется что не работает на USD , всегда показываешь 7,993 .как исправить ?
а так вообще супер просто .

Есть готовая UDF функция для иморта курсов валют с сайта НБУ. Посмотри здесь:
http://moonexcel.ho.ua/index.php?page=tip_kursNBU_ua

EducatedFool, спасибо за совет. Поменял - все заработало.

Добрый день, EducatedFool,

У меня вопрос по поводу точности Вашего макроса - почему-то не всегда корректно значение четвертого знака после запятой? Ведь, насколько я понял, запрос к серверу ЦБР возвращает значения с четырьмя знаками после запятой.

Комментарий Сумма (Евро) Дата Курс Евро на заданную дату Сумма (Рубли)
По данным с сайта cbr.ru 10000 27.12.2012 40,3659000 403659,00
По данным из Вашего макроса 10000 27.12.2012 40,3658981 403658,98

Если обернуть Ваш макрос в функцию округления с числом разрядов равным 4 (=ОКРУГЛ(GetRate("EUR";"Дата");4)), то результат получается корректный. Можно ли как-нибудь решить эту проблему в макросе?

а с нац банка можно вытаскивать данные ? по гривнам

Чтобы было понятно, как именно не работает данная функция опишу как все происходит у меня в excel. Как только Excel пытается "вылезти" в инет, то выскакивает окошко, с просьбой ввести логин и пароль для доступа в инет по учетной записи, я ввожу, нажимаю "ок" и все нормально, любые функции и макросы, которым нужен доступ в инет работают, как, например, вот этот макрос http://www.planetaexcel.ru/tip.php?aid=91 - получение курса доллара с сайта ЦБ РФ. А при выполнении Вашей функции окошко с запросом логина и пароля не выскакивает и соответственно в качестве результата у меня нули. Честно говоря, я в VBA вообще не силен, может быть, выше приведенный макрос (по ссылке) подскажет вам возможное решение возникшей у меня проблемы?