Столбец со списком дат-напротив него проставить курс ЦБ?

Программирование на Visual Basic for Applications
sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Столбец со списком дат-напротив него проставить курс ЦБ?

Сообщение sonata » 11.11.2003 (Вт) 12:15

Есть в Excel
столбец со списком дат
хотелось бы напротив него проставить курс ЦБ автоматически…Это возможно?
Соглашусь даже с тем, чтобы импортнуть базу курсов валют с cbr.ru,
и вести сравнение уже в ней....Хотя, конечно, лучше с сайта...Но, иногда он глючит...

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 11.11.2003 (Вт) 14:10

Наташа, вы иногда меня просто убиваете :)
Для того, чтобы извлекать курсы валют из интернета (с сайта ЦБР) лучше всего построить Web-query. Если это не устраивает (например я не люблю использовать готовые "вещи в себе", лучше все-же знать, как "это" работает), то можно использовать эту функцию:
Код: Выделить всё
Function GetInetCBRRates(ByVal CurrencyID As String, Optional ByVal RateDate) As Currency
Dim inet As Object, itbl As Object, U As String
Dim curID As String, curCode As String, curName As String, curK As Long, curRate As Currency
Dim R As Long, C As Long, Z As String, fFind As Boolean
Const URL As String = "http://www.cbr.ru/currency_base/D_print.asp?date_req=#D#/#M#/#Y#"
Const READYSTATE_UNINITIALIZED As Long = 0&
Const READYSTATE_LOADING As Long = 1&
Const READYSTATE_LOADED As Long = 2&
Const READYSTATE_INTERACTIVE As Long = 3&
Const READYSTATE_COMPLETE As Long = 4&
If IsMissing(RateDate) Then RateDate = Now Else RateDate = CDate(RateDate)
U = URL
U = Replace(U, "#D#", Format$(RateDate, "DD"))
U = Replace(U, "#M#", Format$(RateDate, "MM"))
U = Replace(U, "#Y#", Format$(RateDate, "YYYY"))
Set inet = CreateObject("InternetExplorer.Application")
inet.Navigate U
Do Until inet.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Set itbl = inet.Document.All.Tags("TABLE").Item(2)
For R = 1 To itbl.Rows.Length - 1
  For C = 1 To itbl.Rows(R).Cells.Length
    Z = itbl.Rows(R).Cells(C - 1).InnerText
    Select Case C
      Case 1
        curID = Z
      Case 2
        curCode = Z
      Case 3
        Z = Replace(Z, " ", "")
        Z = Replace(Z, ",", ".")
        curK = CLng(Z)
        If curK = 0 Then curK = 1
      Case 4
        curName = Z
      Case 5
        Z = Replace(Z, " ", "")
        Z = Replace(Z, ",", ".")
        curRate = CCur(Z)
    End Select
    If C = 5 Then
      If CurrencyID = curID Then fFind = True
      If UCase$(CurrencyID) = UCase$(curCode) Then fFind = True
    End If
    If fFind Then Exit For
  Next C
  If fFind Then Exit For
Next R
Set itbl = Nothing
inet.Quit
Set inet = Nothing
If fFind Then GetInetCBRRates = curRate / curK
End Function

Функция замечательно работает при однократном запуске, но при последовательном запуске бывают сбои. Нужно организовывать задержку между запусками функции.
И наконец. Если есть столбец с датами и столбец с курсами, зачем изобретать велосипед? В Excel есть функции ВПР() и СМЕЩ() в сочетании с ПОИСКПОЗ(), которые сделают всю эту подстановку полностью автоматической.
Lasciate ogni speranza, voi ch'entrate.

sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Сообщение sonata » 11.11.2003 (Вт) 15:55

Приятно, что меня уже знают по имени...
alibek , почему же я Вас так убиваю?
Мне совсем этого не хочется...
А функцию, действительно глючит...меня это не совсем
устраивает,лучше уж копировать данные, а потом -сверять.
но, там у меня появились другие вопросы, которые Вас, надеюсь,окончательно не заморозили? :wink:


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot и гости: 31

    TopList