VBA(输入必填字段并将表导出到Excel)

时间:2019-02-25 17:45:36

标签: excel vba automation

    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)按“输入”以获取通知数据库。3)单击“加载”按钮多次,以显示所有行使价。我的代码未能做到这一点。我希望从您那里得到任何建议。

0 个答案:

没有答案