返回列表 上一主題 發帖

想要優化網路爬取選股網站資料

本帖最後由 quickfixer 於 2021-7-15 14:02 編輯

回復 1# vuptp6

執行test
    Sub test()
    Dim getxml As Object, url As String, temp, t As Double
    t = Timer
    Set getxml = CreateObject("msxml2.xmlhttp")
    url = "https://fubon-ebrokerdj.fbs.com.tw/Z/ZC/ZCL/CZCL3.DJBCD?A=2330&B=Y"
    getxml.Open "GET", url, False
    getxml.send
    temp = Split(getxml.responsetext, " ")
    Application.ScreenUpdating = False
    Cells.Clear
    For i = 1 To 5
    Call col(i, Split(temp(Choose(i, 0, 5, 6, 2, 3)), ","))
    Next i
    Set getxml = Nothing
    Range("f1") = Timer - t & "秒"
    Application.ScreenUpdating = True

End Sub

Sub col(c, temp)
    r = 1
    For j = UBound(temp) To 0 Step -1
    r = r + 1
        If c = 1 Then Cells(r, c) = "'" & temp(j) Else Cells(r, c) = temp(j)
    Next j
End Sub

TOP

回復 4# vuptp6



是從 chrome F12 追踨到的資料來源網址

每一行都看不懂,那你可能要從vba入門學習,加油:)

TOP

回復 6# vuptp6


    Sub fubon()
   
    Dim URL As String, Html As Object, GetXml As Object, table, i As Integer, j As Integer, t As Double
    Cells.Clear
    t = Timer
    Application.ScreenUpdating = False
    Set Html = CreateObject("htmlfile")
    Set GetXml = CreateObject("msxml2.xmlhttp")
    URL = "https://fubon-ebrokerdj.fbs.com.tw/z/zc/zcl/zcl.djhtm?a=2330&c=2019-1-1&d=2019-12-31"
   
    With GetXml
        .Open "GET", URL, False
        .send
        Html.body.innerhtml = .responsetext
        Set table = Html.all.tags("table")(2).Rows
        For i = 1 To table.Length - 1
            For j = 0 To table(i).Cells.Length - 2
                Cells(i, j + 1) = Trim(table(i).Cells(j).innertext)
            Next j
        Next i
    End With
    Rows("1:5").Delete Shift:=xlUp
    Range("D:D,E:E,H:H,I:I,J:J").Delete Shift:=xlToLeft
    Application.ScreenUpdating = True
    Range("f1") = Timer - t & "秒"
    Cells.Columns.AutoFit
    Set Html = Nothing
    Set GetXml = Nothing
        
End Sub


stock.wearn.com 改2行,刪除列欄不要,亂碼用文字蓋過就好,其餘同上

URL = "https://stock.wearn.com/cdata.asp?Year=110&month=07&kind=2330"
Set table = Html.all.tags("table")(0).Rows

TOP

回復 7# quickfixer


    stock.wearn.com 漏改一行
.Cells.Length - 2  改 .Cells.Length - 1

TOP

        靜思自在 : 慈悲沒有敵人,智慧不起煩惱。
返回列表 上一主題