Необходимо указать формулу для расчёта курса доллара в диапазоне E2:E4 для заданных дат из диапазона D2:D4, используя данные таблицы A1:B17. Предположим формула бесконечная.
=ВПР(D2;A2:B17;2;)
А у меня другая (18 января ??? )
=ВПР(D2;A:B;2)
=ПРОСМОТР(D2;A:A;B:B)
=ИНДЕКС(B:B;ПОИСКПОЗ(D2;A:A))
Эта помощь уже не нужна?
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=98740&TITLE_SEO=98740-raschet-kursa-valyut
Недавно для своих нужд написал функцию. Можно прямо в ячейке получать курс НБУ на указанную дату.
Может будет кому-то полезна.
Если дату явно не указывать, то будет выведен курс для текущей даты
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
Я давно использую похожую функцию:
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""> EUR</td> -- начало второй ячейки с выравниванием "налево" <td align=""left"">; два неразрывных пробела (отступ текста от левого края второй ячейки) буквенный код валюты EUR ; конец второй ячейки </td>
'<td align=""right"">1</td> -- начало третьей ячейки с выравниванием "направо" <td align=""right"">; кол-во единиц 1 ; конец третьей ячейки </td>
'<td> Евро</td> -- начало четвертой ячейки <td> ; два неразрывных пробела (отступ текста от левого края ячейки) название валюты Евро ; конец четвертой ячейки </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
Доброго дня, всем!
Цитата: Serge 007 от 30.11.2017, 17:26
Я давно использую похожую функцию: ...
Не получилось: - в модуль книги скопировал Вашу функцию, на листе, в ячейку ввожу функцию - возвращает 0.
Шо то делаю не то, а вот шо?
У сайта ЦБ поменялась ссылка и немного изменился код страницы.
Обсуждалось:
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=4&TID=105269&TITLE_SEO=105269-plex-perestala-rabotat-funktsiya-vstavki-kursov-valyut-na-zadannuyu-da
Замените в коде строки
Запрос = "http://cbr.ru/currency_base/daily/?date_req=" & Format(Дата, "dd.mm.yyyy")
и
Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, UCase(Код_Валюты)), Ответ, ",") - 2, 7))
УРА! vikttur и boa!! - Дай бог здоровья этим людям!