返回列表 上一主題 發帖

抓取網頁資料

抓取網頁資料

https://histock.tw/stock/financial.aspx?no=3032&t=2
各位大神 如何抓取從上面網址內的表格資料 小弟想學vba XMLHTTP 勞煩各位大大了
2019-04-28_205821.png
2019-4-28 20:58

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

回復 2# Scott090


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

TOP

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

  33.       End With

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

TOP

回復 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 於 2019-5-11 00:20 編輯

回復 5# Scott090
2019-05-11_013126.png
2019-5-11 00:14

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

2019-05-11_013614.png
2019-5-11 00:18

TOP

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

回復 6# zheng211016

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

TOP

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

回復 9# Scott090


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

TOP

        靜思自在 : 要用心,不要操心、煩心。
返回列表 上一主題