Import kursów wymiany NBU w Excel (NBU_RATE)

Gotowa funkcja dla tych, którzy często muszą korzystać z kursów wymiany NBU w Excel. Pomaga automatycznie wstawić wartości waluty według jej kodu i daty stronie internetowej NBU . Dedykowane pracownikom banków Ukrainy.

Otwórz menu Service - Macros - Visual Basic Editor, włóż nowy moduł (menu Insert - Module) i skopiuj tam tekst tej funkcji:

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

Zamknij Visual Basic Editor i wróć do Excel.

Teraz w Function wizard w kategorii User zdefiniowanej możesz znaleźć naszą funkcję NBU_RATE i z niej skorzystać. Składnia tej funkcji jest następująca:

=NBU_RATE ( kod waluty ; data )

Będziemy mieli następujący wynik: