麻辣家族討論版版 - Powered by Discuz! Board

標題: 抓取網頁資料 [打印本頁]

作者: zheng211016 時間: 2019-4-28 20:58 標題: 抓取網頁資料

https://histock.tw/stock/financial.aspx?no=3032&t=2
各位大神如何抓取從上面網址內的表格資料小弟想學vba XMLHTTP 勞煩各位大大了
[attach]30478[/attach]

作者: Scott090 時間: 2019-4-30 06:33

回復 1# zheng211016

請參考：
Sub byXMLhttp_Test()

   Dim sh As Worksheet
   Dim t!, i%, j%, k%
   Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$

   URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"

   Set sh = Worksheets("試驗頁")
   Set myXML = CreateObject("Microsoft.XMLHTTP")
   Set myHTML = CreateObject("HTMLFile")

   With myXML
      .Open "GET", URL, False
      .send
      If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
         myHTML.body.innerhtml = .responsetext
   End With
   Set myTable = myHTML.getelementsbytagname("TABLE")(0)

   With myTable
         i = .Rows.Length: j = .Rows(3).Cells.Length
         ReDim arDATA(i, j)
         k = 0
         For i = 1 To .Rows.Length
               If .Rows(i - 1).innertext <> "" Then
                     k = k + 1
                     For j = 1 To .Rows(0).Cells.Length
                           arDATA(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                     Next
               End If
         Next

   End With

   sh.Cells.Clear
   sh.[A1].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA

   Set myXML = Nothing
   Set myHTML = Nothing
   Set myTable = Nothing
End Sub

作者: zheng211016 時間: 2019-5-9 17:52

回復 2# Scott090

感謝大大指教測試完有點小問題就是會各少一行一列 , 另外資料有辦法從a1開始放置嗎?

作者: zheng211016 時間: 2019-5-9 18:08

回復 2# Scott090

Scott090 大大我花費了一段時間認識了程式碼後自行解決了問題還請大大過目

另外想請教陣列跟單一哪個花費起來的時間跟空間會比較多?

Sub byXMLhttp_Test2()
Dim sh As Worksheet
Dim t!, i%, j%, k%
Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$
URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
Set sh = Worksheets("試驗頁")
Set myXML = CreateObject("Microsoft.XMLHTTP")
Set myHTML = CreateObject("HTMLFile")
sh.Cells.Clear
With myXML
.Open "GET", URL, False
.send
If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
myHTML.body.innerhtml = .responsetext
End With
Set myTable = myHTML.getelementsbytagname("TABLE")(0)
With myTable
i = .Rows.Length: j = .Rows(0).Cells.Length
ReDim arDATA(i, j)
k = 0 '
For i = 1 To .Rows.Length
If .Rows(i - 1).innertext <> "" Then
k = k + 1
For j = 1 To .Rows(0).Cells.Length
Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
Next
End If
Next
End With
Set myXML = Nothing
Set myHTML = Nothing
Set myTable = Nothing
End Sub

複製代碼

作者: Scott090 時間: 2019-5-10 06:41

回復 4# zheng211016

  看資料的多寡，資料多的話是用陣列會較快。

不了解版主的意思，
1. "各少一行一列"  是甚麼資料漏掉了? 請舉例以便明白。
   2. 依照這個版本，它已經是從 [A1] 開始了。
         k=0
         For i = 1 To .Rows.Length
               If .Rows(i - 1).innertext <> "" Then
                     k = k + 1
                     For j = 1 To .Rows(0).Cells.Length
                           sh.Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                     Next
               End If
         Next

作者: zheng211016 時間: 2019-5-11 00:17

本帖最後由 zheng211016 於 2019-5-11 00:20 編輯

回復 5# Scott090
[attach]30562[/attach]
我測試的結果如上他從B2開始放置陣列資料
我說錯是少了增資認購價這欄而已
另外請問S大你如何找出他是第幾table , 還有若今天資料是會變動的那要怎抓
例如這個網站 : http://mis.twse.com.tw/stock/fibest.jsp?stock=3231
以下圖內兩個大表格資料(橫的那個還有買賣5檔)

[attach]30563[/attach]

作者: Scott090 時間: 2019-5-11 07:55

回復 6# zheng211016

請注意參考紅字的部分，陣列從 1 開始：
Option Base 1
Sub byXMLhttp_Test2()

   Dim sh As Worksheet
   Dim t!, i%, j%, k%
   Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$

   URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
   Set sh = Worksheets("試驗頁")
   Set myXML = CreateObject("Microsoft.XMLHTTP")
   Set myHTML = CreateObject("HTMLFile")
   sh.Cells.Clear
   With myXML
      .Open "GET", URL, False
      .send
      If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
         myHTML.body.innerhtml = .responsetext
   End With
   Set myTable = myHTML.getelementsbytagname("TABLE")(0)

   With myTable
         i = .Rows.Length: j = .Rows(0).Cells.Length
         ReDim arDATA(i, j)

         k = 0 '
         For i = 1 To .Rows.Length
               If .Rows(i - 1).innertext <> "" Then
                     k = k + 1
                     For j = 1 To .Rows(0).Cells.Length
                              Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                              arDATA(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                     Next
               End If
         Next

   End With
  sh.[A15].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
   Set myXML = Nothing
   Set myHTML = Nothing
   Set myTable = Nothing

End Sub

作者: Scott090 時間: 2019-5-11 08:32

回復 6# zheng211016

   "例如這個網站 : http://mis.twse.com.tw/stock/fibest.jsp?stock=3231"
   通常 "TWSE" 這個網站用程式對快速提取資料好像會阻擋 IP 連線，
   我不會用，常常失敗；抱歉

作者: Scott090 時間: 2019-5-11 08:53

回復 6# zheng211016

假如版大願意從 Excel 內的資料來源"連結web" 錄製 VBA 的話：
Sub 巨集1()
'
' 巨集1 巨集
' With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://histock.tw/stock/financial.aspx?no=3032&t=2", Destination:=Range _
      ("$A$1"))
      .Name = "financial.aspx?no=3032&t=2"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
  '.WebTables = "1"，但程式裡是從 "0" 起算的所以 "1" 就是 Table 0。
   .WebTables = "1"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With
Application.Left = 155.8
Application.Top = 76
End Sub
   以上僅供參考

作者: zheng211016 時間: 2019-5-13 16:45

回復 9# Scott090

實測沒問題謝謝您 Scott090 大大你謙虛了感謝大大讓我受益良多 !!!!!

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)