抓取網頁資料

帖子: 521
主題: 55
精華: 0
積分: 598
點名: 280
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-12-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

2^#

發表於 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

　暱稱: zheng逸

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

3^#

發表於 2019-5-9 17:52 | 只看該作者

回復 2# Scott090

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

　暱稱: zheng逸

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

4^#

發表於 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

複製代碼

帖子: 521
主題: 55
精華: 0
積分: 598
點名: 280
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-12-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

5^#

發表於 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

　暱稱: zheng逸

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

6^#

發表於 2019-5-11 00:17 | 只看該作者

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

回復 5# Scott090

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

帖子: 521
主題: 55
精華: 0
積分: 598
點名: 280
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-12-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

7^#

發表於 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

帖子: 521
主題: 55
精華: 0
積分: 598
點名: 280
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-12-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

8^#

發表於 2019-5-11 08:32 | 只看該作者

回復 6# zheng211016

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

帖子: 521
主題: 55
精華: 0
積分: 598
點名: 280
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-12-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

9^#

發表於 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
   以上僅供參考

　暱稱: zheng逸

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

10^#

發表於 2019-5-13 16:45 | 只看該作者

回復 9# Scott090

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