- 帖子
- 154
- 主題
- 1
- 精華
- 0
- 積分
- 200
- 點名
- 28
- 作業系統
- windwos 7
- 軟體版本
- 64bit
- 閱讀權限
- 20
- 註冊時間
- 2017-5-29
- 最後登錄
- 2024-10-22
|
4#
發表於 2021-5-30 00:27
| 只看該作者
本帖最後由 quickfixer 於 2021-5-30 00:33 編輯
01學來的
從原始資料處理會比較快,不用1秒整頁全抓下來,33個表格,自己看要留什麼
變數stock strYear strSeason,自己換上
Sub test()
Dim URL As String, HTMLsourcecode As Object, GetXml As Object
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
URL = "https://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=2012&SYEAR=2020&SSEASON=3&REPORT_ID=C"
Cells.Clear
Application.ScreenUpdating = False
With GetXml
.Open "GET", URL, False
.send
HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
For k = 0 To HTMLsourcecode.all.tags("table").Length - 1
Set Table = HTMLsourcecode.all.tags("table")(k).Rows
For i = 0 To Table.Length - 1
lastrow = lastrow + 1
For j = 0 To Table(i).Cells.Length - 1
If InStr(Table(i).Cells(j).innerhtml, "SPAN class=zh") > 0 Then
ActiveSheet.Cells(lastrow, j + 1) = Trim(Replace(Split(Table(i).Cells(j).innerhtml, "</SPAN>")(0), "<SPAN class=zh>", ""))
Else
ActiveSheet.Cells(lastrow, j + 1) = Trim(Table(i).Cells(j).innertext)
End If
Next j
Next i
Next k
End With
Application.ScreenUpdating = False
Set HTMLsourcecode = Nothing
Set GetXml = Nothing
End Sub
Function convertraw(rawdata)
Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
.Charset = "big5"
convertraw = .ReadText
.Close
End With
Set rawstr = Nothing
End Function |
|
