20180226xlVbaGetStockData

Sub LoopGetStockData()
Dim StartTime As Variant
    Dim UsedTime As Variant
    StartTime = VBA.Timer

    Cells.ClearContents
    For y = 2017 To 2007 Step -1
        For s = 4 To 1 Step -1
            GetStockData "600000", y, s
        Next s
    Next

UsedTime = VBA.Timer - StartTime
    Debug.Print "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")
   'MsgBox "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")

End Sub
Sub GetStockData(ByVal StockNo As String, ByVal YearNo As String, ByVal SeasonNo As String)

    URL = "http://xxx.com/trade/lsjysj_" & StockNo & ".html?year=" & YearNo & "&season=" & SeasonNo
    '发送请求
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        ' With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "Content-Type", "text/html"
        .Send
        WebText = .responsetext
        'Debug.Print WebText
        'Range("A1").Value = WebText
    End With

    Dim OneTable As Object
    Dim OneTh As Object
    Dim OneTr As Object
    Dim tHead As Object
    Dim tBody As Object
    Dim r As Long, c As Long
    With CreateObject("htmlfile")
        .write WebText
        Set OneTable = .getElementsByTagName("table")(3)
        r = Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
        If r = 2 Then r = 1

        Set tHead = OneTable.FirstChild
        Set tr = tHead.FirstChild
        c = 0
        If r = 1 Then
            For Each OneTh In tr.ChildNodes
                c = c + 1
                Cells(r, c).Value = OneTh.innerText
            Next OneTh
        End If
        Set tBody = tHead.NextSibling
        For Each OneTr In tBody.ChildNodes
            r = r + 1
            c = 0

            For Each td In OneTr.ChildNodes
                c = c + 1
                Cells(r, c).Value = td.innerText
            Next td
        Next OneTr

    End With

    Set OneTable = Nothing
    Set OneTh = Nothing
    Set OneTr = Nothing
    Set tHead = Nothing
    Set tBody = Nothing

End Sub