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

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2021-7-14 17:07 | 只看該作者

本帖最後由 singo1232001 於 2021-7-14 17:15 編輯

回復 1# vuptp6

台積電2330.zip (124.76 KB)

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 30
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-11-25

3^#

發表於 2021-7-15 13:52 | 只看該作者

本帖最後由 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

vuptp6

帖子: 16
主題: 3
精華: 0
積分: 65
點名: 0
作業系統: windows7
軟體版本: office2010
閱讀權限: 20
註冊時間: 2019-2-19
最後登錄: 2024-9-23

4^#

發表於 2021-7-15 15:20 | 只看該作者

回復 2# singo1232001
回復 3# quickfixer

謝謝singo1232001及quickfixer兩位的幫助
因為本人技術不夠能力也不足實在看不懂兩位前輩寫的內容(難過)
說實在的其實每一行都看不懂
quickfixer您可以跟我說明網址怎麼由
https://fubon-ebrokerdj.fbs.com.tw/z/zc/zcl/zcl.djhtm?a=2330&c=2021-1-1&d=2021-7-13
變成
https://fubon-ebrokerdj.fbs.com.tw/Z/ZC/ZCL/CZCL3.DJBCD?A=2330&B=Y

我是不是要放棄網路爬資料
資料庫及網頁的知識我完全沒有

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 30
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-11-25

5^#

發表於 2021-7-15 15:44 | 只看該作者

回復 4# vuptp6

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

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

vuptp6

帖子: 16
主題: 3
精華: 0
積分: 65
點名: 0
作業系統: windows7
軟體版本: office2010
閱讀權限: 20
註冊時間: 2019-2-19
最後登錄: 2024-9-23

6^#

發表於 2021-7-16 09:39 | 只看該作者

回復 5# quickfixer

謝謝你
vba我只會基本的儲存格的控制複製等等
從網頁、網路抓取完全一竅不通甚麼js,xhmal等等的
之前都是用錄製
可是抓取下來的效率不太好

另外提問
https://fubon-ebrokerdj.fbs.com.tw/Z/ZC/ZCL/CZCL3.DJBCD?A=2330&B=Y
這個網址從該券商的伺服器抓出來的資料
我怎麼改日期區間都是從110/01/13開始
例如
https://fubon-ebrokerdj.fbs.com.tw/z/zc/zcl/zcl.djhtm?a=2330&c=2019-1-1&d=2019-12-31
他一樣是給這個網址
https://fubon-ebrokerdj.fbs.com.tw/Z/ZC/ZCL/CZCL3.DJBCD?A=2330&B=Y
資料並非從2019年(108)開始

若是這個網頁
https://stock.wearn.com/cdata.asp?Year=110&month=07&kind=2330
似乎不能套用該方法
能否指導其他方式擷取

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 30
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-11-25

7^#

發表於 2021-7-16 14:30 | 只看該作者

回復 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