Новости:

Подпишитесь на рассылку новых сообщений форума через службу рассылок: Subscribe.ru

Главное меню

Формула для расчета курса валют

Автор Lilya, 30.11.2017, 15:38

« назад - далее »

Lilya

Необходимо указать формулу для расчёта курса доллара в диапазоне E2:E4 для заданных дат из диапазона D2:D4, используя данные таблицы A1:B17. Предположим формула бесконечная.

Serge 007

Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

_Boroda_

А у меня другая (18 января ??? )
=ВПР(D2;A:B;2)
=ПРОСМОТР(D2;A:A;B:B)
=ИНДЕКС(B:B;ПОИСКПОЗ(D2;A:A))
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

vikttur


boa

Недавно для своих нужд написал функцию. Можно прямо в ячейке получать курс НБУ на указанную дату.
Может будет кому-то полезна.
Если дату явно не указывать, то будет выведен курс для текущей даты

Function Get_NBU_Rates(sCurr As String, Optional dDate As Date) As Double
'  Author:  boa
'  Description: Возвращает курс НБУ для указанной валюты на заданную дату
'               sCurr - буквенный код валюты. Например: "EUR", "USD", "RUB" и т.п.
    On Error Resume Next
    Dim oHttp As Object
    Dim sURI$, htmlcode$
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then Err.Clear: Set oHttp = CreateObject("MSXML2.XMLHTTPRequest"):
    If oHttp Is Nothing Then Exit Function
   
    On Error GoTo 0
    If dDate = 0 Then dDate = Date
    sURI = "https://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?valcode=" & sCurr & "&date=" & Format(dDate, "YYYYMMDD")
    oHttp.Open "GET", sURI, False
    oHttp.send: DoEvents
    htmlcode = oHttp.responseText
    Get_NBU_Rates = CDbl(Val(GetTagsNBU(htmlcode, "rate")))
End Function
Private Function GetTagsNBU(ByVal htmlcode$, ByVal TagName$) As String
'    Debug.Print htmlcode
    If InStr(1, htmlcode, TagName) Then
        Dim str$: str = Split(htmlcode, TagName)(1)
        GetTagsNBU = Replace(Replace(str, ">", ""), "</", "")
    End If
End Function
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Serge 007

Я давно использую похожую функцию:
Function КурсЦБР(Optional Код_Валюты = "USD", Optional ByVal Дата) As Currency   ' запрос курса любой валюты с сайта ЦБ РФ
'---------------------------------------------------------------------------------------
' Procedure : КурсЦБР
' Author    : Основа - ZVI:2008-10-31, коррекция - Alex_ST: 2010-01-28
' URL       : http://www.planetaexcel.ru/forum.php?thread_id=3816
' Date      : 28.01.2010
' Purpose   : Определение курса валют, установленного ЦБР на заданную дату [по умолчанию - текущая дата]
' Notes     : Валюта - любая [по умолчанию - доллар США] из публикуемых на сайте ЦБРФ
'             http://cbr.ru/currency_base/daily.aspx
'             Вместо кода валюты можно вводить уникальную часть её названия:
'             (вместо "BUR" можно ввести "Белорусских рублей" или "белорус")
'             Примеры вызова в формуле ячейки:
'             =КурсЦБР()или =КурсЦБР("USD") или =КурсЦБР("сШа") - курс USD для текущей даты
'             =КурсЦБР(;"2008-10-30")или =КурсЦБР(;"2008.10.30") или =КурсЦБР("сШа") - курс USD для даты 2008.10.30
'             Аналогично:
'             =КурсЦБР("EUR") или =КурсЦБР("еВрО") - курс EUR для текущей даты
'             =КурсЦБР("EUR";"2008/10/30") или =КурсЦБР("EUR";ДАТА(2008;10;30))
'---------------------------------------------------------------------------------------
    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" & ГОД
    On Error Resume Next
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    If Err <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
    If oHttp Is Nothing Then Exit Function
    oHttp.Open "GET", Запрос, False
    oHttp.Send
    Ответ = UCase(oHttp.responseText)
    'В HTML-коде, получаемом по запросу от сервера ЦБРФ, строка таблицы для, например, Евро выглядит как:
    '(с соблюдением переноса строк)
    '<tr><td align=""right"">978</td>         -- начало новой строки <tr>; начало первой ячейки с выравниванием "направо" <td align=""right"">; цифровой код валюты 978 ; конец первой ячейки </td>
    '<td align=""left"">&nbsp;&nbsp;EUR</td>  -- начало второй ячейки с выравниванием "налево" <td align=""left"">; два неразрывных пробела (отступ текста от левого края второй ячейки) &nbsp; буквенный код валюты EUR ; конец второй ячейки </td>
    '<td align=""right"">1</td>               -- начало третьей ячейки с выравниванием "направо" <td align=""right"">; кол-во единиц 1 ; конец третьей ячейки </td>
    '<td>&nbsp;&nbsp;Евро</td>                -- начало четвертой ячейки <td> ; два неразрывных пробела (отступ текста от левого края ячейки) &nbsp; название валюты Евро ; конец четвертой ячейки </td>
    '<td align=""right"">42,5905</td></tr>    -- начало пятой ячейки с выравниванием "направо" <td align=""right"">; курс 42,5905 ;конец ячейки </td> и строки </tr>
    Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, UCase(Код_Валюты)), Ответ, "</TD></TR>") - 7, 7))
    ' найти в стринге-ответе (HTML-коде) позицию слова UCase(Код_Валюты), например, "USD"
    ' начиная с этой позиции найти позицию конца строки - HTML-тэги "</td></tr>"
    ' отступить от найденной позиции на -7 символов и взять от этой позиции 7 символов - это и есть курс
    Set oHttp = Nothing
    КурсЦБР = Курс
End Function
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

GWolf

Доброго дня, всем!

Цитата: Serge 007 от 30.11.2017, 17:26
Я давно использую похожую функцию: ...

Не получилось: - в модуль книги скопировал Вашу функцию, на листе, в ячейку ввожу функцию - возвращает 0.

Шо то делаю не то, а вот шо?
Путей к вершине - множество. Этот один из многих!

vikttur


boa

Замените в коде строки
Запрос = "http://cbr.ru/currency_base/daily/?date_req=" & Format(Дата, "dd.mm.yyyy")
и
Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, UCase(Код_Валюты)), Ответ, ",") - 2, 7))
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

GWolf

УРА! vikttur и boa!! - Дай бог здоровья этим людям!
Путей к вершине - множество. Этот один из многих!