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

Вход

Регистрация

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

 

= Мир MS Excel/Загрузка курса валют с банка Украины - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка курса валют с банка Украины (Макросы/Sub)
Загрузка курса валют с банка Украины
kkravets Дата: Четверг, 11.02.2016, 12:23 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток,

суть моей темы - макрос(модуль) по импорту курса валют в эксель с оф сайта Нац Банка Украины.

Идея такова: в одну ячейку пишется Валюта (USD/EUR и тд), в соседнюю дата (дд.мм.гггг, хотя дальше может потребуется писать и ггггммдд в целях ссылки на страницу хмл). Рядом вставляется формула =GetRate(A2,В2), где А2 В2 соответсвенно ссылки на ячейки, ранее описанные. Я финансист и слаб в написании макросов, но пытался сам разобраться, что получилось:

Ссылка откуда надо брать: http://bank.gov.ua/NBUStat....ГГГММДД , где ГГГГММДД - год, месяц, день (пример 10.02.2016 - 20160210)

Что у меня на сейчас есть:

[vba]
Код

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Integer) As Single

    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://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    
    If xmldoc.Load(url_request) <> True Then Exit Function

    Set nodeList = xmldoc.selectNodes("exchange"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        If xmlNode.childNodes(1).Text = CurrencyName Then
            CurrencyRate = CDbl(xmlNode.childNodes(4).Text)
            GetRate = CurrencyRate
            Exit Function
        End If
    Next
End Function
[/vba]

Прощу помощи с адаптированием ее к данной ссылке или же у кого есть уже рабочий макрос(модуль) для выполнения подобной операции - буду очень признателен
 
Ответить
СообщениеДоброго времени суток,

суть моей темы - макрос(модуль) по импорту курса валют в эксель с оф сайта Нац Банка Украины.

Идея такова: в одну ячейку пишется Валюта (USD/EUR и тд), в соседнюю дата (дд.мм.гггг, хотя дальше может потребуется писать и ггггммдд в целях ссылки на страницу хмл). Рядом вставляется формула =GetRate(A2,В2), где А2 В2 соответсвенно ссылки на ячейки, ранее описанные. Я финансист и слаб в написании макросов, но пытался сам разобраться, что получилось:

Ссылка откуда надо брать: http://bank.gov.ua/NBUStat....ГГГММДД , где ГГГГММДД - год, месяц, день (пример 10.02.2016 - 20160210)

Что у меня на сейчас есть:

[vba]
Код

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Integer) As Single

    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://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    
    If xmldoc.Load(url_request) <> True Then Exit Function

    Set nodeList = xmldoc.selectNodes("exchange"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        If xmlNode.childNodes(1).Text = CurrencyName Then
            CurrencyRate = CDbl(xmlNode.childNodes(4).Text)
            GetRate = CurrencyRate
            Exit Function
        End If
    Next
End Function
[/vba]

Прощу помощи с адаптированием ее к данной ссылке или же у кого есть уже рабочий макрос(модуль) для выполнения подобной операции - буду очень признателен

Автор - kkravets
Дата добавления - 11.02.2016 в 12:23
Manyasha Дата: Четверг, 11.02.2016, 13:17 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
kkravets, вот так получилось:
[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) 'As Double
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    Debug.Print url_request
    
    If xmldoc.Load(url_request) <> True Then Exit Function
    Set nodeList = xmldoc.SelectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        If nodeList.Item(i).ChildNodes.Length = 4 Then
            If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then
                GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ","))
                Exit Function
            End If
        End If
    Next
End Function
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеkkravets, вот так получилось:
[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) 'As Double
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    Debug.Print url_request
    
    If xmldoc.Load(url_request) <> True Then Exit Function
    Set nodeList = xmldoc.SelectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        If nodeList.Item(i).ChildNodes.Length = 4 Then
            If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then
                GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ","))
                Exit Function
            End If
        End If
    Next
End Function
[/vba]

Автор - Manyasha
Дата добавления - 11.02.2016 в 13:17
kkravets Дата: Четверг, 11.02.2016, 15:03 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Огромное спасибо!! Работает, однако хотел кое-что уточнить:

При использовании формулы по вышеисправленному макросу результат валюты пишется просто 8ми-значным числом без резделения запятой и в местах где котировка заканчивается на "00", например 2689.7800, подтячивается только 6-значное число без нулей, что соотвественно мешает если я хочу для получения только 4х знаков перед запятой просто сделать деление в ячейке на 100***

Чем можно в макросе поставить идентичный перенос формата числа и убрать удаление нулей?
К сообщению приложен файл: 2089896.jpg (37.7 Kb)
 
Ответить
СообщениеОгромное спасибо!! Работает, однако хотел кое-что уточнить:

При использовании формулы по вышеисправленному макросу результат валюты пишется просто 8ми-значным числом без резделения запятой и в местах где котировка заканчивается на "00", например 2689.7800, подтячивается только 6-значное число без нулей, что соотвественно мешает если я хочу для получения только 4х знаков перед запятой просто сделать деление в ячейке на 100***

Чем можно в макросе поставить идентичный перенос формата числа и убрать удаление нулей?

Автор - kkravets
Дата добавления - 11.02.2016 в 15:03
SLAVICK Дата: Четверг, 11.02.2016, 15:22 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Чем можно в макросе поставить идентичный перенос формата числа и убрать удаление нулей

Проверил - работает корректно сразу - см. вложение
У Вас какой формат ячеек в файле? может в них причина?
К сообщению приложен файл: 4686306-2-.xls (42.0 Kb)


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

Проверил - работает корректно сразу - см. вложение
У Вас какой формат ячеек в файле? может в них причина?

Автор - SLAVICK
Дата добавления - 11.02.2016 в 15:22
Manyasha Дата: Четверг, 11.02.2016, 15:23 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
kkravets, у меня нормально выводит, с запятыми (см. файл).

Покажите свой результат в файле.
К сообщению приложен файл: 20160211_kkrave.xlsm (14.6 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеkkravets, у меня нормально выводит, с запятыми (см. файл).

Покажите свой результат в файле.

Автор - Manyasha
Дата добавления - 11.02.2016 в 15:23
kkravets Дата: Четверг, 11.02.2016, 15:39 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вот таким образом у меня отображается все. При открытии ваших файлов - все как надо. После подтвеждения включения макроса - становится все слитно.
К сообщению приложен файл: 6906795.jpg (45.4 Kb) · CurrencyRates_N.xlsm (20.9 Kb)
 
Ответить
СообщениеВот таким образом у меня отображается все. При открытии ваших файлов - все как надо. После подтвеждения включения макроса - становится все слитно.

Автор - kkravets
Дата добавления - 11.02.2016 в 15:39
kkravets Дата: Четверг, 11.02.2016, 16:07 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Может быть причиной является блокировка какой-то функции средствами защиты моего рабочего компьютера в компании? (Постоянно выдается Protected View), после того я нажимаю отключить его - все также сливается в одно восьмизначное число.
 
Ответить
СообщениеМожет быть причиной является блокировка какой-то функции средствами защиты моего рабочего компьютера в компании? (Постоянно выдается Protected View), после того я нажимаю отключить его - все также сливается в одно восьмизначное число.

Автор - kkravets
Дата добавления - 11.02.2016 в 16:07
SLAVICK Дата: Четверг, 11.02.2016, 16:13 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Постоянно выдается Protected View

Так у Вас Англ. офис?
Попробуйте так - что выдаст?:
[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date)
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    Debug.Print url_request
    
    If xmldoc.Load(url_request) <> True Then Exit Function
    Set nodeList = xmldoc.SelectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        If nodeList.Item(i).ChildNodes.Length = 4 Then
            If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then
'                GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ","))
                GetRate = nodeList.Item(i).ChildNodes(2).Text
                Exit Function
            End If
        End If
    Next
End Function
[/vba]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Постоянно выдается Protected View

Так у Вас Англ. офис?
Попробуйте так - что выдаст?:
[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date)
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
    Debug.Print url_request
    
    If xmldoc.Load(url_request) <> True Then Exit Function
    Set nodeList = xmldoc.SelectNodes("*/currency")
    For i = 0 To nodeList.Length - 1
        If nodeList.Item(i).ChildNodes.Length = 4 Then
            If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then
'                GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ","))
                GetRate = nodeList.Item(i).ChildNodes(2).Text
                Exit Function
            End If
        End If
    Next
End Function
[/vba]

Автор - SLAVICK
Дата добавления - 11.02.2016 в 16:13
kkravets Дата: Четверг, 11.02.2016, 16:25 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Работает, запятые как надо расставляет, однако при 1234.5670 и подобном - все "0" в конце все еще не отображаются. Есть ли возможность это исправить. Как я вижу уже, при формате "текст", должно отображаться все символы и 0 в том числе или есть еще способы их отобразить?
 
Ответить
СообщениеРаботает, запятые как надо расставляет, однако при 1234.5670 и подобном - все "0" в конце все еще не отображаются. Есть ли возможность это исправить. Как я вижу уже, при формате "текст", должно отображаться все символы и 0 в том числе или есть еще способы их отобразить?

Автор - kkravets
Дата добавления - 11.02.2016 в 16:25
SLAVICK Дата: Четверг, 11.02.2016, 16:33 | Сообщение № 10
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
олжно отображаться все символы и 0 в том числе или есть еще способы их отобразить?

Поменяйте формат ячейки - поставьте числовой и разрядность увеличьте, у меня нет англ. офиса потестить не могу.
или в коде попробуйте прописать вместо
[vba]
Код
GetRate = nodeList.Item(i).ChildNodes(2).Text
[/vba]
так
[vba]
Код
GetRate = Format(nodeList.Item(i).ChildNodes(2).Text, "0.000000")
[/vba]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
олжно отображаться все символы и 0 в том числе или есть еще способы их отобразить?

Поменяйте формат ячейки - поставьте числовой и разрядность увеличьте, у меня нет англ. офиса потестить не могу.
или в коде попробуйте прописать вместо
[vba]
Код
GetRate = nodeList.Item(i).ChildNodes(2).Text
[/vba]
так
[vba]
Код
GetRate = Format(nodeList.Item(i).ChildNodes(2).Text, "0.000000")
[/vba]

Автор - SLAVICK
Дата добавления - 11.02.2016 в 16:33
Manyasha Дата: Четверг, 11.02.2016, 16:39 | Сообщение № 11
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
kkravets, тогда может так (поставьте нужное количество нулей в формате)?
[vba]
Код
GetRate = Format(nodeList.Item(i).ChildNodes(2).Text, "0.00000000")
[/vba]

Ярослав уже опередил :)


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Четверг, 11.02.2016, 16:40
 
Ответить
Сообщениеkkravets, тогда может так (поставьте нужное количество нулей в формате)?
[vba]
Код
GetRate = Format(nodeList.Item(i).ChildNodes(2).Text, "0.00000000")
[/vba]

Ярослав уже опередил :)

Автор - Manyasha
Дата добавления - 11.02.2016 в 16:39
kkravets Дата: Четверг, 11.02.2016, 17:14 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Все работает как часы! Спасибо! Вы скрасили мои рабочие будни)
 
Ответить
СообщениеВсе работает как часы! Спасибо! Вы скрасили мои рабочие будни)

Автор - kkravets
Дата добавления - 11.02.2016 в 17:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка курса валют с банка Украины (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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