VBA (введите обязательное поле и экспортируйте таблицу в Excel) - PullRequest
0 голосов
/ 25 февраля 2019
    Option Explicit
Public Sub GetTable()
    Dim ws As Worksheet, ie As Object, table As Object, headers()
    Dim obj As Object, startk As Long, endk As Long
    Dim headersTop As Object, ele As Object

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set ie = CreateObject("InternetExplorer.Application")
    headers = Array("OI", "Volume", "IV", "Bid/Ask", "Last", "Strike", "Last", "Bid/Ask", "IV", "Volume", "OI")  '<== This is second row of headers

    startk = InputBox("Min strike price:")
    endk = InputBox("Max strike price:")

    With ie
        .Visible = True
        .Navigate2 "https://www.hkex.com.hk/Market-Data/Futures-and-Options-Prices/Equity-Index/Hang-Seng-Index-Futures-and-Options?sc_lang=en#&product=HSI"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Application.Wait Now + TimeSerial(0, 0, 10)

        .document.getElementsByClassName("mss_list val valstart").Value = "startk"


        .document.getElementsByClassName("mss_list val valend").Value = "endk"

        Application.SendKeys "{ENTER}"
        .document.getElementsByName("load").Item.Click

        Set table = .document.querySelector("#option")
        Set headersTop = .document.querySelectorAll("#option tr:first-child th")  '<== This is top row of headers which involves merged table cells. I prepare the excel sheet in the same way in the code below.
        ws.Range("A1:D1").Merge
        ws.Range("A1").Value = headersTop.Item(0).innerText  ' CALL
        ws.Range("E1:G1").Merge
        ws.Range("E1") = headersTop.Item(1).innerText  '< Date
        ws.Range("H1:K1").Merge
        ws.Range("H1") = headersTop.Item(2).innerText  '< PUT
        ws.Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
        Dim r As Long, c As Long, td As Object, tr As Object
        r = 3
        For Each tr In table.getElementsByClassName("tdrow") 'loop the rows below the headers by using class name to isolate
            c = 1
            For Each td In tr.getElementsByTagName("td") '< loop table cells i.e. columns of rows
                ws.Cells(r, c) = IIf(c Mod 4 = 0, "'" & td.innerText, td.innerText)  '< If column number is 4 or 8 then add "'" in front so formatting preserved
            c = c + 1
            Next
            r = r + 1
        Next
        .Quit
    End With
End Sub

Выше приведен мой код для извлечения данных из hkex , где я хочу указать две цены исполнения и получить подробную информацию об этих опциях.Процесс 1) ввести две цены исполнения.2) нажмите «enter», чтобы получить базу данных в уведомлении. 3) несколько раз нажмите кнопку «load» для отображения всей цены исполнения.Я не смог сделать это с моим кодом.Я надеюсь получить от вас какой-либо совет.

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