VBA Excel парсинг HTML - PullRequest
0 голосов
/ 09 июня 2018

Помогите мне, пожалуйста.Я новичок в VBA.Ниже приведен полностью рабочий код, отображающий данные в нужном диапазоне.Как сохранить измененный HTML-документ для дальнейшего его анализа?Если я сразу проанализирую, то по умолчанию он будет анализировать данные с диапазоном.

Sub ParsingTest1()

Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLAs As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement
IE.Visible = True
IE.navigate "http://www.cbr.ru/hd_base/dv/?P1=4"

Do While IE.ReadyState <> READYSTATE_COMPLETE
Loop

Set HTMLDoc = IE.Document

Set HTMLInput = HTMLDoc.getElementById("UniDbQuery_FromDate")
HTMLInput.Value = "13.01.2013"

Set HTMLInput = HTMLDoc.getElementById("UniDbQuery_ToDate")
HTMLInput.Value = "12.12.2017"

Set HTMLInput = HTMLDoc.getElementById("UniDbQuery_searchbutton")
HTMLInput.Click

1 Ответ

0 голосов
/ 09 июня 2018

Посмотрите на приведенный ниже пример:

Option Explicit

Sub Test()

    Dim s As String
    Dim a() As String
    Dim q As Range
    Dim i As Long

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://www.cbr.ru/hd_base/dv/?P1=4", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send "UniDbQuery.Posted=True&UniDbQuery.P1=4&UniDbQuery.FromDate=13.01.2013&UniDbQuery.ToDate=12.12.2017"
        s = .ResponseText
    End With
    a = Split(s, "<td>")
    ThisWorkbook.Sheets(1).Cells.Delete
    Set q = ThisWorkbook.Sheets(1).Cells(1, 1)
    For i = 1 To UBound(a) Step 2
        q.Value = CDate(Split(a(i), "</td>", 2)(0))
        Set q = q.Offset(0, 1)
        q.Value = CDbl(Replace(Split(a(i + 1), "</td>", 2)(0), " ", ""))
        Set q = q.Offset(1, -1)
    Next
    ThisWorkbook.Sheets(1).Columns.AutoFit

End Sub

Вывод для меня выглядит следующим образом:

output

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...