Function Курс_НБУ(sCurr$, Optional ByVal Дата) ' курсы валют к гривне в НБУ
'sCurr - код валюты USD EUR RUB BYR … см. на http://www.bankstore.com.ua/currencyrates/dailyrates/
    Dim sURL$, objHttp As Object, sHtmlCode$
    Dim sDay$, sMonth$, sYear$
    Dim CurrRate!, lPosCurrRate&
    Dim sValue$, QTY%, lPosTdClass&
    Dim sTdClass$, lTbPos&
    '-------------------------------------------------------------------------------
    Application.Volatile
    If IsMissing(Дата) Then Дата = Date
    If Дата = "" Then Курс_НБУ = CVErr(xlErrValue): Exit Function    ' вернуть ошибку #ЗНАЧЕНИЕ
    If Not IsDate(Дата) Then Дата = CDate(Дата)
    Дата = CDate(Дата)
    sDay = Format(Дата, "dd"): sMonth = Format(Дата, "mm"): sYear = Format(Дата, "yyyy")
    sURL = "http://www.bankstore.com.ua/currencyrates/dailyrates/123286/?currency_id=16&year=" & sYear & "&month=" & sMonth & "&day=" & sDay & "&rate_type=0"
    On Error Resume Next
    Set objHttp = CreateObject("MSXML2.XMLHTTP.3.0")
    If Err.Number <> 0 Then
    Err.Clear
    Set objHttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then Set objHttp = CreateObject("MSXML.XMLHTTPRequest")
    End If
    If objHttp Is Nothing Then Курс_НБУ = CVErr(xlErrValue): Exit Function   ' вернуть ошибку #ЗНАЧЕНИЕ
    objHttp.Open "GET", sURL, False
    On Error Resume Next
    objHttp.Send
    If Err.Number <> 0 Then Курс_НБУ = CVErr(xlErrValue): Exit Function    ' вернуть ошибку #ЗНАЧЕНИЕ
    On Error GoTo 0
    sHtmlCode = objHttp.responseText
    Set objHttp = Nothing
    On Error Resume Next
    sCurr = UCase(sCurr) ' на всякий случай
    sTdClass = "<td class="""" align=""center"">"
    lPosTdClass = InStr(InStr(1, sHtmlCode, sCurr), sHtmlCode, sTdClass) 'начало текста нужной ячейки
    sValue = Trim(Mid(sHtmlCode, lPosTdClass + Len(sTdClass), InStr(lPosTdClass, sHtmlCode, "</td>") - lPosTdClass - Len(sTdClass)))
    QTY = --(sValue) ' за количество единиц
    sTdClass = "<td class=""rate"">"
    lPosTdClass = InStr(InStr(1, sHtmlCode, sCurr), sHtmlCode, sTdClass) 'начало текста нужной ячейки
    sValue = Trim(Mid(sHtmlCode, lPosTdClass + Len(sTdClass), InStr(lPosTdClass, sHtmlCode, "</td>") - lPosTdClass - Len(sTdClass)))
    CurrRate = CSng(Trim(Replace(sValue, ".", ",")))
    Курс_НБУ = FormatNumber(WorksheetFunction.Round(CurrRate / QTY, 4), 4)
End Function

Application.Volatile False