Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Функции (UDF) "Курс_Доллара" и "Курс_Евро" - Страница 4 - Мир MS Excel

Старая форма входа
  • Страница 4 из 4
  • «
  • 1
  • 2
  • 3
  • 4
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Готовые решения » Функции (UDF) "Курс_Доллара" и "Курс_Евро" (Возвращают в ячейку курсы USD и EUR с сервера ЦБ РФ)
Функции (UDF) "Курс_Доллара" и "Курс_Евро"
Serge_007 Дата: Среда, 25.03.2015, 11:39 | Сообщение № 61
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2748 ±
Замечаний: ±

Excel 2016
Возможно


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеВозможно

Автор - Serge_007
Дата добавления - 25.03.2015 в 11:39
Alex_ST Дата: Среда, 25.03.2015, 13:27 | Сообщение № 62
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3199
Репутация: 606 ±
Замечаний: 0% ±

2003
такой же файл но со ссылкой на иностранные нац банки сделать возможно ?

Возможно

Ну, в общем-то каков вопрос, таков и ответ hands
А если серьёзно, то можно, но ведь все макросы работают на принципе разбора конкретных Html-кодов с конкретных сайтов, т.к. нет стандарта представления информации с жёстко заданными именами полей записей баз данных.



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
такой же файл но со ссылкой на иностранные нац банки сделать возможно ?

Возможно

Ну, в общем-то каков вопрос, таков и ответ hands
А если серьёзно, то можно, но ведь все макросы работают на принципе разбора конкретных Html-кодов с конкретных сайтов, т.к. нет стандарта представления информации с жёстко заданными именами полей записей баз данных.

Автор - Alex_ST
Дата добавления - 25.03.2015 в 13:27
Hunter23071985 Дата: Четверг, 26.03.2015, 08:57 | Сообщение № 63
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
разбора конкретных Html-кодов с конкретных сайтов

Как вариант, можно зачитать информацию с какого-нибудь агрегатора курсов валют банков.


Сообщение отредактировал Hunter23071985 - Четверг, 26.03.2015, 08:57
 
Ответить
Сообщение
разбора конкретных Html-кодов с конкретных сайтов

Как вариант, можно зачитать информацию с какого-нибудь агрегатора курсов валют банков.

Автор - Hunter23071985
Дата добавления - 26.03.2015 в 08:57
savafso Дата: Понедельник, 06.04.2015, 15:58 | Сообщение № 64
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Уважаемый Андрей {krosav4ig} !
Из Вашего поста №57 у меня не получилось "прикрутить" котировки драгоценных металлов - ОМС Сбербанка со страницы http://data.sberbank.ru/oryol/ru/quotes/metal/ чтобы выводились в ячейки B2 и B3 - покупка/продажа золота соответственно и в ячейки C2 и C3 - покупка/продажа серебра соответственно на текущий день в формате 0,00 р.
Подскажите как реализовать?!?
Остальные металлы не интересуют!


Сообщение отредактировал savafso - Понедельник, 06.04.2015, 16:04
 
Ответить
СообщениеУважаемый Андрей {krosav4ig} !
Из Вашего поста №57 у меня не получилось "прикрутить" котировки драгоценных металлов - ОМС Сбербанка со страницы http://data.sberbank.ru/oryol/ru/quotes/metal/ чтобы выводились в ячейки B2 и B3 - покупка/продажа золота соответственно и в ячейки C2 и C3 - покупка/продажа серебра соответственно на текущий день в формате 0,00 р.
Подскажите как реализовать?!?
Остальные металлы не интересуют!

Автор - savafso
Дата добавления - 06.04.2015 в 15:58
Rama Дата: Вторник, 07.04.2015, 13:57 | Сообщение № 65
Группа: Пользователи
Ранг: Участник
Сообщений: 59
Репутация: 0 ±
Замечаний: 20% ±

2010
Так все таки, функция для СБЕРБАНКА покупки и продажи есть ? Просто курс не интересен. Мы валюту покупаем и продаем и там курс другой.
Вот ссылки на курсы продаж и покупок
http://sberbank.ru/ru/person
http://data.sberbank.ru/moscow/ru/quotes/currenciespremier/?base=beta
 
Ответить
СообщениеТак все таки, функция для СБЕРБАНКА покупки и продажи есть ? Просто курс не интересен. Мы валюту покупаем и продаем и там курс другой.
Вот ссылки на курсы продаж и покупок
http://sberbank.ru/ru/person
http://data.sberbank.ru/moscow/ru/quotes/currenciespremier/?base=beta

Автор - Rama
Дата добавления - 07.04.2015 в 13:57
savafso Дата: Вторник, 07.04.2015, 16:31 | Сообщение № 66
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вопрос с котировками ОМС Сбербанка решился, спасибо Киру!
Готовый скрипт на VBA

P.S: Работает пока структуру сайта не поменяют :)
Помещает в область указанную в strRange (ИмяЛиста! ячейка) данные с сайта или "Нет данных", если не удалось их получить.
iTimeOut - время ожидания в секундах.

Готовый файл приложен...
К сообщению приложен файл: 0474556.xlsm (18.6 Kb)


Сообщение отредактировал savafso - Вторник, 07.04.2015, 16:33
 
Ответить
СообщениеВопрос с котировками ОМС Сбербанка решился, спасибо Киру!
Готовый скрипт на VBA

P.S: Работает пока структуру сайта не поменяют :)
Помещает в область указанную в strRange (ИмяЛиста! ячейка) данные с сайта или "Нет данных", если не удалось их получить.
iTimeOut - время ожидания в секундах.

Готовый файл приложен...

Автор - savafso
Дата добавления - 07.04.2015 в 16:31
Rama Дата: Вторник, 07.04.2015, 17:10 | Сообщение № 67
Группа: Пользователи
Ранг: Участник
Сообщений: 59
Репутация: 0 ±
Замечаний: 20% ±

2010
Не то увидел и расстроился, но поменял ссылку на http://data.sberbank.ru/moscow/ru/quotes/currencies/ и все получилось, вытянул курс по валюте, что и искал.
Соответственно спасибо savafso и иже с ним.

Вопрос: если вдруг структура поменяется, то достаточно заново определить местоположение цифр с курсом, но как их найти ? Есть значение в макросе Const strSiteTableClass As String = "table3_eggs4" , где этот table3_eggs4 спрятался ?
 
Ответить
СообщениеНе то увидел и расстроился, но поменял ссылку на http://data.sberbank.ru/moscow/ru/quotes/currencies/ и все получилось, вытянул курс по валюте, что и искал.
Соответственно спасибо savafso и иже с ним.

Вопрос: если вдруг структура поменяется, то достаточно заново определить местоположение цифр с курсом, но как их найти ? Есть значение в макросе Const strSiteTableClass As String = "table3_eggs4" , где этот table3_eggs4 спрятался ?

Автор - Rama
Дата добавления - 07.04.2015 в 17:10
savafso Дата: Вторник, 07.04.2015, 17:27 | Сообщение № 68
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Rama, при просмотре кода страницы (Ctrl + U) http://data.sberbank.ru/moscow/ru/quotes/currencies/ поиском найти (Ctrl + F) искомую комбинацию (table3_eggs4) не трудно :)


Сообщение отредактировал savafso - Вторник, 07.04.2015, 17:28
 
Ответить
СообщениеRama, при просмотре кода страницы (Ctrl + U) http://data.sberbank.ru/moscow/ru/quotes/currencies/ поиском найти (Ctrl + F) искомую комбинацию (table3_eggs4) не трудно :)

Автор - savafso
Дата добавления - 07.04.2015 в 17:27
Rama Дата: Вторник, 07.04.2015, 17:36 | Сообщение № 69
Группа: Пользователи
Ранг: Участник
Сообщений: 59
Репутация: 0 ±
Замечаний: 20% ±

2010
1. Я не правильно выразился...где на странице сайта найти table3_eggs4 ? Если структура поменяется, то поменяется и table3_eggs4. Как определить table3_eggs4 на странице сайта
2. Код протестировал, цифры по формату ставлю 4 знака, а он мне опять один/два знака дает. Что поправить
3. Если я меняю название страницы, то ошибка то же
 
Ответить
Сообщение1. Я не правильно выразился...где на странице сайта найти table3_eggs4 ? Если структура поменяется, то поменяется и table3_eggs4. Как определить table3_eggs4 на странице сайта
2. Код протестировал, цифры по формату ставлю 4 знака, а он мне опять один/два знака дает. Что поправить
3. Если я меняю название страницы, то ошибка то же

Автор - Rama
Дата добавления - 07.04.2015 в 17:36
Gameower Дата: Среда, 09.09.2015, 10:56 | Сообщение № 70
Группа: Пользователи
Ранг: Участник
Сообщений: 95
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
вставил описаную функцию но она не работает у меня, может чего не сделал?
[moder]Нет, как раз наоборот, сделал - влез в тему ветки "Готовые решения" с вопросом.
Идите обратно в свою тему.
И Правила форума еще раз прочитайте.
К сообщению приложен файл: _DANFOSS.xlsm (50.3 Kb)


Сообщение отредактировал Gameower - Среда, 09.09.2015, 11:10
 
Ответить
Сообщениевставил описаную функцию но она не работает у меня, может чего не сделал?
[moder]Нет, как раз наоборот, сделал - влез в тему ветки "Готовые решения" с вопросом.
Идите обратно в свою тему.
И Правила форума еще раз прочитайте.

Автор - Gameower
Дата добавления - 09.09.2015 в 10:56
Fantom-by Дата: Четверг, 11.02.2016, 21:51 | Сообщение № 71
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Уважаемый Alex_ST, может вы сможете помочь, есть некоторая таблица эксель, 1й столбец (А:А) - дата, 2й столбец (B:B) - курс RUR (необходимо брать из
), 3й столбец (C:C) -курс USD (отлично отрабатывает через ваш макрос с crb.ru), так вот, как я не крутился, не получается у меня изменить Ваш макрос так, что бы он на ту дату по которой мы 2жды кликаем (в столбце А:А), брал с сайта nbrb.by курс росийского рубля и заносил в столбец B:B в ячейку напротив даты по которой кликаем и с сайта crb.ru брал курс USD и заносил в столбец C:C в ячейку напротив даты по которой кликаем.
Я ну очень извиняюсь за наглость, опыта у меня в программировании не много, надеюсь Вы подскажете как правильно изменить, Спасибо!


Сообщение отредактировал Fantom-by - Четверг, 11.02.2016, 21:58
 
Ответить
СообщениеУважаемый Alex_ST, может вы сможете помочь, есть некоторая таблица эксель, 1й столбец (А:А) - дата, 2й столбец (B:B) - курс RUR (необходимо брать из
), 3й столбец (C:C) -курс USD (отлично отрабатывает через ваш макрос с crb.ru), так вот, как я не крутился, не получается у меня изменить Ваш макрос так, что бы он на ту дату по которой мы 2жды кликаем (в столбце А:А), брал с сайта nbrb.by курс росийского рубля и заносил в столбец B:B в ячейку напротив даты по которой кликаем и с сайта crb.ru брал курс USD и заносил в столбец C:C в ячейку напротив даты по которой кликаем.
Я ну очень извиняюсь за наглость, опыта у меня в программировании не много, надеюсь Вы подскажете как правильно изменить, Спасибо!

Автор - Fantom-by
Дата добавления - 11.02.2016 в 21:51
Alex_ST Дата: Четверг, 11.02.2016, 22:40 | Сообщение № 72
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3199
Репутация: 606 ±
Замечаний: 0% ±

2003
Я так понимаю, что нужно переделать UDF так, чтобы не с банка РФ брало, а с Беларуси?
Это-то как раз и самое неприятное и требующее долгой возни - сделать запрос на страничку на сервере так, чтобы он правильно понял и внятно ответил. Тут как раз я не силён - в первом же посте писАл, что основа - от Павла (Pavel55) с Планеты.
Да и времени у меня сейчас совсем на работе свободного не стало. А дома я не пишу.
Но где-то здесь на форуме или на Планете я уже, кажется, видел, что с банка Беларуси считывают курсы...
Пошарьте Поиском по форуму.
---------
За 1 минуту, выйдя на главную форума, нашёл по строке nbrb.by в этом же топике нечто похожее в ЭТОМ посте
Ройте дальше сами.



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Четверг, 11.02.2016, 22:44
 
Ответить
СообщениеЯ так понимаю, что нужно переделать UDF так, чтобы не с банка РФ брало, а с Беларуси?
Это-то как раз и самое неприятное и требующее долгой возни - сделать запрос на страничку на сервере так, чтобы он правильно понял и внятно ответил. Тут как раз я не силён - в первом же посте писАл, что основа - от Павла (Pavel55) с Планеты.
Да и времени у меня сейчас совсем на работе свободного не стало. А дома я не пишу.
Но где-то здесь на форуме или на Планете я уже, кажется, видел, что с банка Беларуси считывают курсы...
Пошарьте Поиском по форуму.
---------
За 1 минуту, выйдя на главную форума, нашёл по строке nbrb.by в этом же топике нечто похожее в ЭТОМ посте
Ройте дальше сами.

Автор - Alex_ST
Дата добавления - 11.02.2016 в 22:40
krosav4ig Дата: Пятница, 12.02.2016, 01:57 | Сообщение № 73
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Fantom-by, можно как-то так


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеFantom-by, можно как-то так

Автор - krosav4ig
Дата добавления - 12.02.2016 в 01:57
Serge1400 Дата: Воскресенье, 24.07.2016, 03:34 | Сообщение № 74
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вариант функций через XML запрос с сайта ЦБР
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

Function GetEUR(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='R01239']")
If nodeList.Length Then GetEUR = CDbl(nodeList.Item(0).ChildNodes(4).Text)
End Function


Доброй ночи!
А подкажите можно ли объединить эти две функции чтобы в итого получалась одно значение (кросс-курс): то есть курс Евро поделеный на курс Доллара на текущую дату.
Сейчас эти функции сидят в двух ячейках, а кросс-курс считаеся в третьей. И уже оттуда значение копипастится по необходимости макросом в ячейку, связанную с расчетами. Как то все тяжеловато и перенасыщенно получается.


Сообщение отредактировал Serge1400 - Воскресенье, 24.07.2016, 11:32
 
Ответить
Сообщение
Вариант функций через XML запрос с сайта ЦБР
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

Function GetEUR(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='R01239']")
If nodeList.Length Then GetEUR = CDbl(nodeList.Item(0).ChildNodes(4).Text)
End Function


Доброй ночи!
А подкажите можно ли объединить эти две функции чтобы в итого получалась одно значение (кросс-курс): то есть курс Евро поделеный на курс Доллара на текущую дату.
Сейчас эти функции сидят в двух ячейках, а кросс-курс считаеся в третьей. И уже оттуда значение копипастится по необходимости макросом в ячейку, связанную с расчетами. Как то все тяжеловато и перенасыщенно получается.

Автор - Serge1400
Дата добавления - 24.07.2016 в 03:34
_Boroda_ Дата: Воскресенье, 24.07.2016, 12:19 | Сообщение № 75
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Самое простое - написать вот так
Код
=GetEUR()/GetUSD()

Изменить макрос - просто добавить во второй то, что есть в первом, но отсутствует во втором
Примерно так (в код не вникал вообще, просто тупо добавил отсутствующее)
[vba]
Код
Function GetEUR_USD(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 nodeList1 = xmldoc.SelectNodes("//Valute[@ID='R01235']")
Set nodeList2 = xmldoc.SelectNodes("//Valute[@ID='R01239']")
If nodeList1.Length And nodeList.Length2 Then
    GetEUR_USD = CDbl(nodeList2.Item(0).ChildNodes(4).Text / nodeList1.Item(0).ChildNodes(4).Text)
End If
End Function
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеСамое простое - написать вот так
Код
=GetEUR()/GetUSD()

Изменить макрос - просто добавить во второй то, что есть в первом, но отсутствует во втором
Примерно так (в код не вникал вообще, просто тупо добавил отсутствующее)
[vba]
Код
Function GetEUR_USD(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 nodeList1 = xmldoc.SelectNodes("//Valute[@ID='R01235']")
Set nodeList2 = xmldoc.SelectNodes("//Valute[@ID='R01239']")
If nodeList1.Length And nodeList.Length2 Then
    GetEUR_USD = CDbl(nodeList2.Item(0).ChildNodes(4).Text / nodeList1.Item(0).ChildNodes(4).Text)
End If
End Function
[/vba]

Автор - _Boroda_
Дата добавления - 24.07.2016 в 12:19
Serge1400 Дата: Воскресенье, 24.07.2016, 13:54 | Сообщение № 76
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
[moder]Цитата удалена[/moder]
Саша,и еще раз помог!
Я про первый вариант даже не догадывался. А второй по чесноку сам пытался по такому же алгоритму слепить, но очевидно что-то все таки не так делал. Не работает мой вариант, в отличие от твоего.


Сообщение отредактировал Pelena - Воскресенье, 24.07.2016, 14:19
 
Ответить
Сообщение[moder]Цитата удалена[/moder]
Саша,и еще раз помог!
Я про первый вариант даже не догадывался. А второй по чесноку сам пытался по такому же алгоритму слепить, но очевидно что-то все таки не так делал. Не работает мой вариант, в отличие от твоего.

Автор - Serge1400
Дата добавления - 24.07.2016 в 13:54
Alex_ST Дата: Понедельник, 25.06.2018, 12:23 | Сообщение № 77
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3199
Репутация: 606 ±
Замечаний: 0% ±

2003
В личке мне написали, что после 03.06.2018 вдруг перестала работать UDF Курс_ЕВРО
Сейчас протестировал у себя... Действительно, перестала работать функция :'(
Посмотрел, немного изменился адрес странички, на которую посылается запрос.
Для 25.06.2018 формируется запрос на адрес: http://cbr.ru/currency_base/daily/?date_req=25%2f06%2f2018
Подправил запрос.
Не помогло: всё равно в ответ на запрос курсов на сегодня вместо нормального html-текста выдаёт фигню типа
"<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN" "HTTP://WWW.W3.ORG/TR/XHTML1/DTD/XHTML1-TRANSITIONAL.DTD">
<!-- © ART. LEBEDEV STUDIO | HTTP://WWW.ARTLEBEDEV.RU/ -->

Разбираться надо. А мне некогда...
Вот текст процедуры с подправленным запросом :
[vba]
Код
Function КурсЕвро(Optional ByVal Дата) As Currency   ' запрос курса Евро с сайта ЦБ РФ
'---------------------------------------------------------------------------------------
' Procedure : КурсЕвро
' Author    : Основа - Pavel55, коррекция - Alex_ST: 2010-01-28
' URL       : http://www.planetaexcel.ru/forum.php?thread_id=6870&page_forum=2&allnum_forum=34
' Date      : 28.01.2010
' Purpose   : Запрос курса Евро, установленного ЦБР на заданную дату
' Notes     : По умолчанию - текущая дата
'---------------------------------------------------------------------------------------
   Dim Запрос$, Ответ$, Курс$
   Dim oHttp As Object
   Dim ДЕНЬ$, Месяц$, ГОД$
   Application.Volatile
   If IsMissing(Дата) Then Дата = Date
   If Not IsDate(Дата) Then Дата = CDate(Дата)
   ДЕНЬ = Format(Дата, "dd"): Месяц = Format(Дата, "mm"): ГОД = Format(Дата, "yyyy")
'   Запрос = "http://cbr.ru/currency_base/daily.aspx?C_month=" & Месяц & "&C_year=" & ГОД & "&date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
   Запрос = "http://cbr.ru/currency_base/daily/?date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
   On Error Resume Next
   Set oHttp = CreateObject("MSXML2.XMLHTTP")
   If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
   On Error GoTo 0
   If oHttp Is Nothing Then Exit Function
   oHttp.Open "GET", Запрос, False
   oHttp.Send
   Ответ = UCase(oHttp.responseText)
   Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TD></TR>") - 7, 7))
   Set oHttp = Nothing
   КурсЕвро = Курс
End Function
[/vba]
Сейчас мне ковыряться, к сожалению, некогда…
Может быть кто-то из знамоков посмотрит?



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Понедельник, 25.06.2018, 12:27
 
Ответить
СообщениеВ личке мне написали, что после 03.06.2018 вдруг перестала работать UDF Курс_ЕВРО
Сейчас протестировал у себя... Действительно, перестала работать функция :'(
Посмотрел, немного изменился адрес странички, на которую посылается запрос.
Для 25.06.2018 формируется запрос на адрес: http://cbr.ru/currency_base/daily/?date_req=25%2f06%2f2018
Подправил запрос.
Не помогло: всё равно в ответ на запрос курсов на сегодня вместо нормального html-текста выдаёт фигню типа
"<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN" "HTTP://WWW.W3.ORG/TR/XHTML1/DTD/XHTML1-TRANSITIONAL.DTD">
<!-- © ART. LEBEDEV STUDIO | HTTP://WWW.ARTLEBEDEV.RU/ -->

Разбираться надо. А мне некогда...
Вот текст процедуры с подправленным запросом :
[vba]
Код
Function КурсЕвро(Optional ByVal Дата) As Currency   ' запрос курса Евро с сайта ЦБ РФ
'---------------------------------------------------------------------------------------
' Procedure : КурсЕвро
' Author    : Основа - Pavel55, коррекция - Alex_ST: 2010-01-28
' URL       : http://www.planetaexcel.ru/forum.php?thread_id=6870&page_forum=2&allnum_forum=34
' Date      : 28.01.2010
' Purpose   : Запрос курса Евро, установленного ЦБР на заданную дату
' Notes     : По умолчанию - текущая дата
'---------------------------------------------------------------------------------------
   Dim Запрос$, Ответ$, Курс$
   Dim oHttp As Object
   Dim ДЕНЬ$, Месяц$, ГОД$
   Application.Volatile
   If IsMissing(Дата) Then Дата = Date
   If Not IsDate(Дата) Then Дата = CDate(Дата)
   ДЕНЬ = Format(Дата, "dd"): Месяц = Format(Дата, "mm"): ГОД = Format(Дата, "yyyy")
'   Запрос = "http://cbr.ru/currency_base/daily.aspx?C_month=" & Месяц & "&C_year=" & ГОД & "&date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
   Запрос = "http://cbr.ru/currency_base/daily/?date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
   On Error Resume Next
   Set oHttp = CreateObject("MSXML2.XMLHTTP")
   If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
   On Error GoTo 0
   If oHttp Is Nothing Then Exit Function
   oHttp.Open "GET", Запрос, False
   oHttp.Send
   Ответ = UCase(oHttp.responseText)
   Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TD></TR>") - 7, 7))
   Set oHttp = Nothing
   КурсЕвро = Курс
End Function
[/vba]
Сейчас мне ковыряться, к сожалению, некогда…
Может быть кто-то из знамоков посмотрит?

Автор - Alex_ST
Дата добавления - 25.06.2018 в 12:23
Alex_ST Дата: Понедельник, 25.06.2018, 12:31 | Сообщение № 78
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3199
Репутация: 606 ±
Замечаний: 0% ±

2003
Что за хрень? Обнаружил опечатку, а редактировать ИМЕННО ПРЕДЫДУЩИЙ мой пост сайт не даёт?



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Понедельник, 25.06.2018, 15:18
 
Ответить
СообщениеЧто за хрень? Обнаружил опечатку, а редактировать ИМЕННО ПРЕДЫДУЩИЙ мой пост сайт не даёт?

Автор - Alex_ST
Дата добавления - 25.06.2018 в 12:31
Manyasha Дата: Понедельник, 25.06.2018, 12:58 | Сообщение № 79
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
В "</TD></TR>" перенос строк видимо появился.
Вот так работает:
[vba]
Код
Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TR>") - 18, 7))
[/vba]



ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеВ "</TD></TR>" перенос строк видимо появился.
Вот так работает:
[vba]
Код
Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TR>") - 18, 7))
[/vba]


Автор - Manyasha
Дата добавления - 25.06.2018 в 12:58
Alex_ST Дата: Понедельник, 25.06.2018, 13:21 | Сообщение № 80
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3199
Репутация: 606 ±
Замечаний: 0% ±

2003
Manyasha,
спасибо большое. Проверил - отлично работает во всех вариантах валют! hands hands hands



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Понедельник, 25.06.2018, 15:16
 
Ответить
СообщениеManyasha,
спасибо большое. Проверил - отлично работает во всех вариантах валют! hands hands hands

Автор - Alex_ST
Дата добавления - 25.06.2018 в 13:21
Мир MS Excel » Вопросы и решения » Готовые решения » Функции (UDF) "Курс_Доллара" и "Курс_Евро" (Возвращают в ячейку курсы USD и EUR с сервера ЦБ РФ)
  • Страница 4 из 4
  • «
  • 1
  • 2
  • 3
  • 4
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!