Выгрузка данных с сайта сю VBA

Дата: Четверг, 06.11.2014, 06:34 | Сообщение № 1

Группа: Гости

Доброго времени суток.

Я пытаюсь выгрузить исторические данные (курсы валют по определенным видам) со следующего сайта: http://www.nationalbank.kz/?docid=747&switch=russian

Пробовал фунцию "From Web" в экселе, но там получилось выгрузить только текущие данные. Буду признателен если покажете пример выгрузки истоических данных.

Спасибо.

Дата: Четверг, 06.11.2014, 08:32 | Сообщение № 2

Группа: Гости

Кто-нибудь помогите, пожалуйста.

alex77755

Дата: Четверг, 06.11.2014, 09:26 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 362

Репутация: 64 ±

Замечаний: 0% ±

Попадалось решение не с этого сайта, но принцип можно посмотреть.

К сообщению приложен файл: ____ru.investin.rar (14.6 Kb)

Могу помочь в VB6, VBA
Alex77755@mail.ru

Дата: Четверг, 06.11.2014, 10:48 | Сообщение № 4

Группа: Гости

О, спасибо. Посмотрю.

Дата: Четверг, 06.11.2014, 14:47 | Сообщение № 5

Группа: Гости

Посмотрел код. К сожалению, не получается применить его ...

Сейчас беру след. код за основу, и пытаюсь что-то делать ... Подсказки/советы приветствую ...
Спасибо.

[vba]

Код

Sub test()
Dim IE As Object
Dim doc As Object
Dim colTR As Object
Dim colTD As Object
Dim tr As Object
Dim td As Object
Set IE = CreateObject("InternetExplorer.Application")

IE.Visible = True
IE.Navigate "http://www.nationalbank.kz/?docid=747&switch=russian"

Do Until IE.ReadyState = 4: DoEvents: Loop

Set doc = IE.Document

Set colTR = doc.GetElementsByTagName("TR")

For Each tr In colTR

Set colTD = tr.GetElementsByTagName("TD")

For Each td In colTD
MsgBox td.innertext

Next td

Next tr

IE.Quit

End Sub

[/vba]

Дата: Четверг, 06.11.2014, 17:02 | Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 971

Репутация: 333 ±

Замечаний: 0% ±

Excel 2010

Так должно работать?

К сообщению приложен файл: rate.xlsm (41.4 Kb)

Дата: Пятница, 07.11.2014, 06:45 | Сообщение № 7

Группа: Гости

Благодарю за помощь, Сергей.

Да, код должен работать примерно так. Я попробую модифицировать его, чтобы получить таблицу в формате:

Дата RUB USD EUR GBP
01.01.2013 4,96 150,74 199,22 243,72
02.01.2013 4,96 150,74 199,22 243,72
03.01.2013 4,96 150,74 199,22 243,72
04.01.2013 4,99 150,37 197,96 244,20
05.01.2013 4,96 150,59 195,99 241,70

и добавить фунцию, где можно указать временной период (start date: dd/mm/yyyy, end date: dd/mm/yyyy

Еще раз спасибо огромное.

Дата: Пятница, 07.11.2014, 14:41 | Сообщение № 8

Группа: Гости

Извиняюсь, не могли бы показать код источника следующей строки:

<tr><tdclass=class_rate_bg2colspan=2>([0-9\.]+)</td></tr>

Дата: Пятница, 07.11.2014, 14:53 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 971

Репутация: 333 ±

Замечаний: 0% ±

Excel 2010

Сходите по ссылке,посмотрите html код страницы

Дата: Вторник, 11.11.2014, 13:55 | Сообщение № 10

Группа: Гости

Приветствую.

HTML код посмотрел, нашел вот эти строки где используется "rate":

td width="25" class="gen5" background="images/back_rates.gif"
td valign="top" class="gen5" background="images/back_rates.gif"
td height="35" class="gen2" colspan="6" background="images/back_rates.gif" width="100%"

Можете показать строку, откуда собирается дата?

Хотелось бы выгрузить историю по всем валютам на одном листе. Немножко видоизменил ваш код:

[vba][code]Private Sub CommandButton1_Click()
Dim Id As String, edate As String

edate = Format(Date, "dd\/MM\/yyyy") ' define END date format
Me.Columns("A:EP").ClearContents

For i = 1 To 60
For j = 1 To 121 Step 2
Id = i ' show the currency IDs

URL = "http://www.nationalbank.kz/?docid=747&sDate=01/01/2013&edate=" & edate & _
"&idval=" & Id & "&flag=1&ok3=yes&switch=russian" ' define the URL

Hys = Get_Hys(GetHTTPResponse(URL)) ' store historicals in Hys using the Function, which takes URL address for S?
Me.Cells(4, j).Resize(UBound(Hys) + 1, UBound(Hys, 2) + 1) = Hys
Next j
Next i

End Sub[/code][/vba]

Но почему-то перезаписывает все столбцы ...

Дата: Вторник, 11.11.2014, 16:07 | Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 971

Репутация: 333 ±

Замечаний: 0% ±

Excel 2010

Можно так.Файл HTML прилагаю

[vba]

Код

Private Sub CommandButton1_Click()
     Dim Id As String, edate As String
     Header = Array("1 АВСТРАЛИЙСКИЙ ДОЛЛАР", "1 ФУНТ СТЕРЛИНГОВ СОЕДИНЕННОГО КОРОЛЕВСТВА", "1 ДАТСКАЯ КРОНА", _
                    "1 ДИРХАМ ОАЭ", "1 ДОЛЛАР США", "1 ЕВРО", "1 КАНАДСКИЙ ДОЛЛАР", "1 КИТАЙСКИЙ ЮАНЬ", "1 КУВЕЙТСКИЙ ДИНАР", _
                    "1 КЫРГЫЗСКИЙ СОМ", "1 ЛИТОВСКИЙ ЛИТ", "1 МОЛДАВСКИЙ ЛЕЙ", "1 НОРВЕЖСКАЯ КРОНА", "1 РИЯЛ САУДОВСКОЙ АРАВИИ", _
                    "1 РОССИЙСКИЙ РУБЛЬ", "1 СДР", "1 СИНГАПУРСКИЙ ДОЛЛАР", "100 УЗБЕКСКИХ СУМОВ", "1 УКРАИНСКАЯ ГРИВНА", _
                    "1 ШВЕДСКАЯ КРОНА", "1 ШВЕЙЦАРСКИЙ ФРАНК", "100 ЮЖНО-КОРЕЙСКИХ ВОН", "1 ЯПОНСКАЯ ЙЕНА", "100 БЕЛОРУССКИХ РУБЛЕЙ", _
                    "1 ПОЛЬСКИЙ ЗЛОТЫЙ", "1 ЮЖНО-АФРИКАНСКИЙ РАНД", "1 ТУРЕЦКАЯ ЛИРА", "10 ВЕНГЕРСКИХ ФОРИНТОВ", "1 ЧЕШСКАЯ КРОНА", _
                    "1 ТАДЖИКСКИЙ СОМОНИ", "1 ГОНКОНГСКИЙ ДОЛЛАР", "1 БРАЗИЛЬСКИЙ РЕАЛ", "1 МАЛАЗИЙСКИЙ РИНГГИТ", "1 АЗЕРБАЙДЖАНСКИЙ МАНАТ", _
                    "1 ИНДИЙСКАЯ РУПИЯ", "1 ТАЙСКИЙ БАТ", "10 АРМЯНСКИЙ ДРАМ", "1 ГРУЗИНСКИЙ ЛАРИ", "1000 ИРАНСКИЙ РИАЛ", "1 МЕКСИКАНСКИЙ ПЕСО")

     edate = Format(Date, "dd\/MM\/yyyy")
     Id = Me.Range("I2")
     Me.Columns("A:EP").ClearContents
     URL = "http://www.nationalbank.kz/?docid=747&sDate=01/01/2013&edate=" & edate & _
           "&idval=" & Id & "&flag=1&ok3=yes&switch=russian"

     Hys = Get_Hys(GetHTTPResponse(URL))
     Me.Range("A1").Resize(UBound(Hys) + 1, UBound(Hys, 2) + 1) = Hys
     For i = 1 To 59
         Id = i    ' show the currency IDs
         URL = "http://www.nationalbank.kz/?docid=747&sDate=01/01/2013&edate=" & edate & _
               "&idval=" & Id & "&flag=1&ok3=yes&switch=russian"    ' define the URL
         Hys = Get_Hys(GetHTTPResponse(URL))    ' store historicals in Hys using the Function, which takes URL address for S?
         Me.Cells(3, i + (i - 1) * 2) = Header(i - 1)
         Me.Cells(4, i + (i - 1) * 2).Resize(UBound(Hys) + 1, UBound(Hys, 2) + 1) = Hys
         Me.Cells(3, i + (i - 1) * 2).ColumnWidth = 12
     Next i

End Sub

[/vba]

Можно так.Файл HTML прилагаю

[vba]

Код

[/vba]

К сообщению приложен файл: ___-russian.rar (9.4 Kb)

СообщениеМожно так.Файл HTML прилагаю

[vba]

Код

[/vba]

Автор - doober
Дата добавления - 11.11.2014 в 16:07

Дата: Среда, 12.11.2014, 08:55 | Сообщение № 12

Группа: Гости

Ах ... оказывается, там всего 40 валютных пар и есть пустые интервалы в порядке ID валют (например, отсутствуют 11, 19, 24, 27-38, 43, 47-49) ...
За счет этого образовываются пустые колонны. Заметил я это когда запускал код, вследствие чего вышла ошибка "run time error 9 subscript out of range"

Объясните, пожалуйста, как вы Header ("1 АВСТРАЛИЙСКИЙ ДОЛЛАР", "1 ФУНТ СТЕРЛИНГОВ СОЕДИНЕННОГО КОРОЛЕВСТВА" ...) распарсировали? Я бы хотел применить такой же подход для получния Header-ов типа AUD/KZT, GBP/KZT и т. д. (например, строка class="gen7" align="center">AUD / KZT).

Порекомендуйте, пжлста, ресурсы по разборке HTML и парсинг сайтов в VBA. respect

Дата: Четверг, 13.11.2014, 23:39 | Сообщение № 13

Группа: Друзья

Ранг: Ветеран

Сообщений: 971

Репутация: 333 ±

Замечаний: 0% ±

Excel 2010

Если я вас правильно понял,то видео здесь в виде экзешника
Остальное все опыт,метод проб и ошибок и не один год.
Надо руками щупать.В книгах всего не опишут

shoma_440

Дата: Воскресенье, 25.08.2019, 12:36 | Сообщение № 14

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Добрый день! скиньте пожалуйста ссылку на excel 2016 сумма прописью в Узбекских сумах! спасибо. и подскажите как его установить! спасибо!