Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Мазгаским
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
07.11.2018 14:16:42
Спасибо БОЛЬШОЕ !!! :)

Очень толково все изложено !!!
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
07.11.2018 13:32:40
нет проблема с форматом  
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
06.11.2018 18:36:23
Не работает
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
06.11.2018 16:39:53
В итоге никто ничего не помог :(
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 18:23:43
8)
Изменено: Мазгаским - 05.11.2018 18:33:08
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 16:03:09
Уточните пожалуйста каие библиотеки должны быть подключены ?
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 14:53:04
Задача:
брать с сайта НБУ курс валюты (по коду 840 или 978  и т. д.)   на  указанную дату (в формате ДД.ММ.ГГГГ) - Это вся задача !!! :)
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 14:41:59
Не решает задачу(надо тянуть с сайта курс) можно полный код?
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 14:24:01
Спасибо и все же может кто-нибуть подсказать что нужно поменять в коде?  
 
Перейти    
Курс валют с сайта НБУ на указанную дату, функция NBU_RATE выдает 0
 
#
05.11.2018 14:07:45
Код
Function NBU_RATE(sCurr$, iiDate As Date)
    Dim sURI As String
    Dim oHttp As Object
    Dim htmlcode As String
    sURI = "https://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
    oHttp.send
    htmlcode = Replace(Replace(oHttp.responseText, vbTab, ""), vbCrLf, "")

    bRes = False
    Set RegExp = CreateObject("VBScript.RegExp")

    RegExp.Pattern = "<tr>\s{1,}<td[^>]*>" & sCurr & "</td>\s{1,}" & _
                     "<td[^>]*>(.+?)</td>\s{1,}" & _
                     "<td[^>]*>([0-9]+)</td>\s{1,}" & _
                     "<td[^>]*>(.+?)</td>\s{1,}" & _
                     "<td[^>]*>([0-9\.]+)</td>"

    bRes = RegExp.test(htmlcode)
    If bRes Then
        Set oMatches = RegExp.Execute(htmlcode)
        NBU_RATE = Val(oMatches(0).subMatches(3)) / oMatches(0).subMatches(1)
        Exit Function
    End If
    Exit Function
ConnectionError:
End Function

После переустновки офиса не могу заставить работать корректно следующую функцию(до переустановки работала исправно) выдает значение "0"
Изменено: Мазгаским - 05.11.2018 14:26:52
 
Перейти    
CBR для Украины
 
#
01.11.2018 16:41:45
Цитата
serega124 написал: Можно немного модифицировать функцию CBR() и получим CBU()
у меня не работает не могу понять в чем причина
 
Перейти    
Функция NBU_RATE не работает корректно выдает значение "0", После переустновки офиса не могу заставить работать корректно следующую функцию(до переустановки работала исправно)
 
#
29.08.2018 12:02:38
Выдает не корректный результат "0", а должен быть курс в виде числа.
Код
Function NBU_RATE(sCurr$, iiDate As Date)
   Dim sURI As String
   Dim oHttp As Object
   Dim htmlcode As String
   sURI = "https://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
   oHttp.send
   htmlcode = Replace(Replace(oHttp.responseText, vbTab, ""), vbCrLf, "")

   bRes = False
   Set RegExp = CreateObject("VBScript.RegExp")

   RegExp.Pattern = "<tr>\s{1,}<td[^>]*>" & sCurr & "</td>\s{1,}" & _
                    "<td[^>]*>(.+?)</td>\s{1,}" & _
                    "<td[^>]*>([0-9]+)</td>\s{1,}" & _
                    "<td[^>]*>(.+?)</td>\s{1,}" & _
                    "<td[^>]*>([0-9\.]+)</td>"

   bRes = RegExp.test(htmlcode)
   If bRes Then
       Set oMatches = RegExp.Execute(htmlcode)
       NBU_RATE = Val(oMatches(0).subMatches(3)) / oMatches(0).subMatches(1)
       Exit Function
   End If
   Exit Function
ConnectionError:
End Function

НАДСТРОЙКА ВО ВЛОЖЕНИИ
 
Перейти    
Функция NBU_RATE не работает корректно выдает значение "0", После переустновки офиса не могу заставить работать корректно следующую функцию(до переустановки работала исправно)
 
#
29.08.2018 11:37:18
После переустновки офиса не могу заставить работать корректно следующую функцию(до переустановки работала исправно):

Function NBU_RATE(sCurr$, iiDate As Date)
   Dim sURI As String
   Dim oHttp As Object
   Dim htmlcode As String
   sURI = "https://bank.gov.ua/control/uk/curmetal/currency/search?formType=&quot; & _
          "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
   oHttp.send
   htmlcode = Replace(Replace(oHttp.responseText, vbTab, ""), vbCrLf, "")

   bRes = False
   Set RegExp = CreateObject("VBScript.RegExp")

   RegExp.Pattern = "<tr>\s{1,}<td[^>]*>" & sCurr & "</td>\s{1,}" & _
                    "<td[^>]*>(.+?)</td>\s{1,}" & _
                    "<td[^>]*>([0-9]+)</td>\s{1,}" & _
                    "<td[^>]*>(.+?)</td>\s{1,}" & _
                    "<td[^>]*>([0-9\.]+)</td>"

   bRes = RegExp.test(htmlcode)
   If bRes Then
       Set oMatches = RegExp.Execute(htmlcode)
       NBU_RATE = Val(oMatches(0).subMatches(3)) / oMatches(0).subMatches(1)
       Exit Function
   End If
   Exit Function
ConnectionError:
End Function

Подозреваю что в настройках нехватает галочки по библиотеке котороая поможет правильно преобразовать.

Пожалуйста помогите разобраться в вопросе.

Заранее БЛАГОДАРЮ !!!! ;)  
 
Перейти    
Страницы: 1
Наверх