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

Вход

Регистрация

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

 

= Мир MS Excel/Загрузка значения ключевой ставки с сайта ЦБ РФ - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка значения ключевой ставки с сайта ЦБ РФ (Макросы/Sub)
Загрузка значения ключевой ставки с сайта ЦБ РФ
Яя Дата: Пятница, 02.03.2018, 12:31 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!

Существует ли макрос, который может загружать на лист Excel значение ключевой ставки с сайта ЦБ РФ на заданную дату?

Заранее благодарна.
 
Ответить
СообщениеДобрый день!

Существует ли макрос, который может загружать на лист Excel значение ключевой ставки с сайта ЦБ РФ на заданную дату?

Заранее благодарна.

Автор - Яя
Дата добавления - 02.03.2018 в 12:31
abtextime Дата: Пятница, 02.03.2018, 12:44 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Давно пользуюсь макросом, откуда стащил - не помню

[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double
    ' функция возвращает курс валюты CurrencyName на дату RateDate
    ' в случае ошибки (неверная дата или название валюты) возвращается 0
    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://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy")

    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("*/Valute")
    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)
            divisor = Val(xmlNode.ChildNodes(2).Text)
            GetRate = CurrencyRate / divisor
            Exit Function
        End If
    Next
End Function
[/vba]
К сообщению приложен файл: 6785934.xlsm(17.6 Kb)
 
Ответить
СообщениеДавно пользуюсь макросом, откуда стащил - не помню

[vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double
    ' функция возвращает курс валюты CurrencyName на дату RateDate
    ' в случае ошибки (неверная дата или название валюты) возвращается 0
    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://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy")

    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("*/Valute")
    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)
            divisor = Val(xmlNode.ChildNodes(2).Text)
            GetRate = CurrencyRate / divisor
            Exit Function
        End If
    Next
End Function
[/vba]

Автор - abtextime
Дата добавления - 02.03.2018 в 12:44
Яя Дата: Пятница, 02.03.2018, 12:49 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо, но это курсы валют.
Курсы у меня загружаются, свой макрос есть))
Я затрудняюсь именно с ключевой ставкой.
 
Ответить
СообщениеСпасибо, но это курсы валют.
Курсы у меня загружаются, свой макрос есть))
Я затрудняюсь именно с ключевой ставкой.

Автор - Яя
Дата добавления - 02.03.2018 в 12:49
abtextime Дата: Пятница, 02.03.2018, 12:52 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
ЛОЛ, совсем уже глаз замылился, сорри )))
 
Ответить
СообщениеЛОЛ, совсем уже глаз замылился, сорри )))

Автор - abtextime
Дата добавления - 02.03.2018 в 12:52
abtextime Дата: Пятница, 02.03.2018, 13:54 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Мне кажется, на сайте ЦБ нет сервиса, выдающего ключевую ставку по дате

Но задача проста как яйцо - есть же даты изменений значений КС, например здесь

Ну и вытаскивайте формулой или макросом

Прототип макроса накидал

[vba]
Код
Public Function Stavka(D As Date) As Double
    Dim Stavki()
      
    ChangeDates = "13.09.13,02.03.14,28.04.14,28.07.14"
    Stavki = Array(5.5, 7, 7.5, 8)
    If D < CDate(Mid(ChangeDates, 1, 8)) Then
        Stavka = 0
        Exit Function
    End If
    For i = 0 To UBound(Stavki) - 1
        If D >= CDate(Mid(ChangeDates, i * 9 + 1, 8)) And D < CDate(Mid(ChangeDates, i * 9 + 10, 8)) Then
            Stavka = Stavki(i)
            Exit Function
        End If
    Next i
Stavka = Stavki(UBound(Stavki))
End Function
[/vba]
К сообщению приложен файл: 4079443.xlsm(16.3 Kb)
 
Ответить
СообщениеМне кажется, на сайте ЦБ нет сервиса, выдающего ключевую ставку по дате

Но задача проста как яйцо - есть же даты изменений значений КС, например здесь

Ну и вытаскивайте формулой или макросом

Прототип макроса накидал

[vba]
Код
Public Function Stavka(D As Date) As Double
    Dim Stavki()
      
    ChangeDates = "13.09.13,02.03.14,28.04.14,28.07.14"
    Stavki = Array(5.5, 7, 7.5, 8)
    If D < CDate(Mid(ChangeDates, 1, 8)) Then
        Stavka = 0
        Exit Function
    End If
    For i = 0 To UBound(Stavki) - 1
        If D >= CDate(Mid(ChangeDates, i * 9 + 1, 8)) And D < CDate(Mid(ChangeDates, i * 9 + 10, 8)) Then
            Stavka = Stavki(i)
            Exit Function
        End If
    Next i
Stavka = Stavki(UBound(Stavki))
End Function
[/vba]

Автор - abtextime
Дата добавления - 02.03.2018 в 13:54
Яя Дата: Понедельник, 05.03.2018, 11:30 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
abtextime, мерси))
 
Ответить
Сообщениеabtextime, мерси))

Автор - Яя
Дата добавления - 05.03.2018 в 11:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка значения ключевой ставки с сайта ЦБ РФ (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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