抓取網頁資料

zheng211016

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

下載 (103.88 KB)

2019-4-28 20:58

Scott090

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

回復 2# Scott090


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

zheng211016

回復 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. 
    
34.       End With
    
35. 
    
36.       Set myXML = Nothing
    
37.       Set myHTML = Nothing
    
38.       Set myTable = Nothing
    
39.       
    
40. End Sub

複製代碼

Scott090

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

回復 5# Scott090

下載 (406.11 KB)

2019-5-11 00:14

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

下載 (33.72 KB)

2019-5-11 00:18

Scott090

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

回復 6# zheng211016

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

Scott090

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

回復 9# Scott090


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