ВВЕРХ

Импорт курсов НБУ в Excel (NBU_RATE)

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

Меню Service - Macros - Visual Basic Editor, вставьте новый модуль (меню Insert - Module) и скопируйте туда текст этой функции:

Function NBU_RATE(sCurr$, iiDate As Date)
 'moonexcel.com.ua
 Dim sURI As String
 Dim oHttp As Object
 Dim htmlcode As String
 Dim C As Range
 Dim Q As Long
 Dim iP As Long, z As Long
 Dim S As String, S1 As String, iOnlyTable As String
 Dim b As Object
 Dim massive(30, 5)
 Dim iDatas As Date
 
 sURI = "http://bank.gov.ua/control/uk/curmetal/currency/search?formType=searchFormDate&time_step=daily&date=" & iiDate & "&execute"
 On Error Resume Next
 Set oHttp = CreateObject("MSXML2.XMLHTTP")
 If Err.Number <> 0 Then
 Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
 End If
 If oHttp Is Nothing Then Exit Function
 On Error GoTo ConnectionError
 oHttp.Open "GET", sURI, False
 On Error GoTo ConnectionError
 oHttp.Send
 htmlcode = oHttp.responseText
 iP = InStr(1, htmlcode, "України<"&"br/>встановлює")
 htmlcode = Mid(htmlcode, iP, 10000)
 iP = InStr(1, htmlcode, "<"&"td class=") + 6 + 11 '">
 iDatas = Mid(htmlcode, iP, 10)
 iOnlyTable = Mid(htmlcode, InStr(100, htmlcode, "<"&"table cellpadding="), InStr(1000, htmlcode, "<"&"/table>") - _
 InStr(100, htmlcode, "<"&"table cellpadding=") + 10)'">
 Set Doc = CreateObject("HTMLFile")
 Doc.Write iOnlyTable
 Set b = Doc.all.tags("TABLE")
 
 For Each uTableElement In b
 iRows = uTableElement.Rows.Length
 iCells = uTableElement.Cells.Length
 j = 0
 For k = 1 To iRows
    For l = 1 To 5
        j = j + 1
        massive(k, l) = uTableElement.Cells(j - 1).innerHTML
        If j = uTableElement.Cells.Length Then GoTo 1
    Next l
Next k
1:
 Next uTableElement
 
 For k = 2 To iRows
    For l = 1 To 5
        If massive(k, l) = sCurr Then
            NBU_RATE = Replace(massive(k, 5), ".", ",")
            NBU_RATE = NBU_RATE / massive(k, 3)
        End If
     Next l
Next k

Calculate
NextForLoop:
Set oHttp = Nothing
Exit Function
ConnectionError:
End Function

Закройте Visual Basic Editor и вернитесь в Excel.

Теперь, в Function wizard в категории User definded Вы можете найти нашу функцию NBU_RATE и использовать ее. Синтаксис этой функции такой:

=NBU_RATE (код валюты; дата)

Мы будем иметь такой результат: