返回列表 上一主題 發帖

抓取網頁資料

zheng211016
　暱稱: zheng逸

中學生Rank: 2

帖子
99 
主題
15 
精華
0 
積分
164 
點名
2  
作業系統
WIN7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2017-5-30 
最後登錄
2024-10-5 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-4-28 20:58 | 只看該作者

抓取網頁資料

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

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
258  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-26 

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

TOP

zheng211016
　暱稱: zheng逸

中學生Rank: 2

帖子
99 
主題
15 
精華
0 
積分
164 
點名
2  
作業系統
WIN7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2017-5-30 
最後登錄
2024-10-5 
3#
發表於 2019-5-9 17:52 | 只看該作者
回復 2# Scott090


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

TOP

zheng211016
　暱稱: zheng逸

中學生Rank: 2

帖子
99 
主題
15 
精華
0 
積分
164 
點名
2  
作業系統
WIN7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2017-5-30 
最後登錄
2024-10-5 
4#
發表於 2019-5-9 18:08 | 只看該作者
回復 2# Scott090

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

另外想請教 陣列 跟 單一 哪個花費起來的時間跟空間會比較多?
  1. Sub byXMLhttp_Test2()
  2.       
  3.       Dim sh As Worksheet
  4.       Dim t!, i%, j%, k%
  5.       Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$
  6.    
  7.       URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
  8.       Set sh = Worksheets("試驗頁")
  9.       Set myXML = CreateObject("Microsoft.XMLHTTP")
  10.       Set myHTML = CreateObject("HTMLFile")
  11.       sh.Cells.Clear
  12.       With myXML
  13.           .Open "GET", URL, False
  14.           .send
  15.           If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
  16.            myHTML.body.innerhtml = .responsetext
  17.       End With
  18.       Set myTable = myHTML.getelementsbytagname("TABLE")(0)
  19.       
  20.       With myTable
  21.             i = .Rows.Length: j = .Rows(0).Cells.Length
  22.             ReDim arDATA(i, j)
  23.             
  24.             k = 0 '
  25.             For i = 1 To .Rows.Length
  26.                   If .Rows(i - 1).innertext <> "" Then
  27.                         k = k + 1
  28.                         For j = 1 To .Rows(0).Cells.Length
  29.                                 Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
  30.                         Next
  31.                   End If
  32.             Next

  34.       End With

  36.       Set myXML = Nothing
  37.       Set myHTML = Nothing
  38.       Set myTable = Nothing
  39.       
  40. End Sub
複製代碼

TOP

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
258  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-26 

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

TOP

zheng211016
　暱稱: zheng逸

中學生Rank: 2

帖子
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檔)

TOP

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
258  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-26 

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

TOP

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
258  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-26 

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 連線，
      我不會用，常常失敗； 抱歉

TOP

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
258  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-26 

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

TOP

zheng211016
　暱稱: zheng逸

中學生Rank: 2

帖子
99 
主題
15 
精華
0 
積分
164 
點名
2  
作業系統
WIN7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2017-5-30 
最後登錄
2024-10-5 
10#
發表於 2019-5-13 16:45 | 只看該作者
回復 9# Scott090


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

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題