返回列表 上一主題 發帖

[發問] 如何快速將網頁資料抓到excel裡

[發問] 如何快速將網頁資料抓到excel裡

http://www.twse.com.tw/zh/page/trading/exchange/STOCK_DAY_AVG.html
如何快速將網頁資料抓到excel裡
AB欄位分別是日期跟收盤價
證交所的網址如上
必須一個月一個月去入查詢完後貼到EXCEL裡
請問有什麼方法可以快速得到左邊的結果

日期        收盤價
106/01/03        84.3
106/01/04        84.2
106/01/05        84
106/01/06        83.8
106/01/09        83.5
106/01/10        84
106/01/11        84.2
106/01/12        84.3



Download Page Link
https://www.sendspace.com/file/09cahu

回復 1# paul3063

試試看
  1.     Sub TWSEtest()
  2.       Dim sh As Worksheet
  3.       Dim iDate$, stock$, yYear$, mMonth$, URL$
  4.       Dim arDATA(), Table
  5.       Dim i%, j%

  6.       Set sh = Sheets("工作表1")
  7.       sh.Activate
  8.       Cells.Clear
  9.       
  10.       stock = "2330"          '設定代號
  11.       yYear = "2017"          '設定年度
  12.       mMonth = "01"           '設定月份
  13.       iDate = yYear & mMonth & "01"
  14.       
  15.       URL = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=Html&date=" & iDate & "&stockNo=" & stock
  16.         
  17.       With CreateObject("InternetExplorer.Application")
  18.             .Visible = False     '  不顯示 IE
  19.             .Navigate URL
  20.             Do While .readyState <> 4
  21.             DoEvents
  22.             Loop
  23.             
  24.             Set Table = .document.getElementsBytagname("table")(0)
  25.             
  26.             With Table
  27.                   ReDim arDATA(.Rows.Length, .Rows(1).Cells.Length)
  28.                   For i = 0 To .Rows.Length - 1
  29.                         For j = 0 To .Rows(1).Cells.Length - 1
  30.                               On Error Resume Next
  31.                               arDATA(i + 1, j + 1) = .Rows(i).Cells(j).innertext
  32.                         Next
  33.                   Next
  34.             End With
  35.             
  36.             sh.Cells(1, 1).Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
  37.             [A1].Select
  38.             
  39.             .Quit       '關閉瀏覽器
  40.             
  41.       End With
  42.       
  43.       Set Table = Nothing
  44.       Set sh = Nothing
  45.       Erase arDATA()

  46. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2017-12-21 17:37 編輯

回復 1# paul3063

未命名.png
2017-12-19 18:39

試試看
  1. Option Explicit
  2. Sub Ex_日收盤價及月平均收盤價()
  3.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, i, E, r As Double, c As Double
  4.     Dim StockNo As String, xday As String, xRow As Integer, Day1 As Date, Day2 As Date, xTime As Date
  5.      StockNo = [A2]
  6.      Day1 = ActiveSheet.[B2]
  7.      Day2 = ActiveSheet.[C2]
  8.     For i = 0 To DateDiff("m", Day1, Day2)
  9.         xday = Format(DateAdd("m", i, Day1), "yyyymmdd")
  10.         Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  11.         Set oHtmldoc = CreateObject("htmlfile")
  12.         surl = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=html&date=" & xday & "&stockNo=" & StockNo
  13.         With oXmlhttp
  14.             .Open "Get", surl, False
  15.             .Send
  16.             If InStr(.responseText, "很抱歉,沒有符合條件的資料!") Then
  17.                 MsgBox "很抱歉,沒有符合條件的資料!" & vbLf & "請檢查 股票代號"
  18.                 Exit Sub
  19.             ElseIf InStr(.responseText, "查詢日期小於88年1月5日,請重新查詢") Then
  20.                 MsgBox "查詢日期小於88年1月5日!" & vbLf & "請檢查 起始日期"
  21.                 Exit Sub
  22.             ElseIf InStr(.responseText, "查詢日期大於今日,請重新查詢") Then
  23.                 MsgBox "查詢日期大於今日" & vbLf & "請檢查 終止日期"
  24.                 Exit Sub
  25.             End If
  26.             oHtmldoc.write .responseText
  27.         End With
  28.         With oHtmldoc
  29.             Set E = .all.tags("table")(0)
  30.             With ActiveSheet
  31.                 If i = 0 Then .UsedRange.Offset(2).Clear
  32.                 xRow = .Cells(Rows.Count, "a").End(xlUp).Row + IIf(i = 0, 1, 0)
  33.                
  34.                 For r = IIf(i = 0, 0, 2) To E.Rows.Length - 2 '-1 可顯示月平均收盤價
  35.                     For c = 0 To E.Rows(r).Cells.Length - 1
  36.                     .Cells(xRow + r + IIf(i > 0, -1, 0), c + 1) = E.Rows(r).Cells(c).innertext
  37.                     Next
  38.                 Next
  39.             End With
  40.     End With
  41.     Set oXmlhttp = Nothing
  42.     Set oHtmldoc = Nothing
  43.     Application.StatusBar = "****  " & Format(DateAdd("m", i, Day1), "ee/mm") & "  載完畢 *****"
  44.     '**** 股市營業時間有流量管制 **
  45.     'xTime = Time + #12:00:09 AM#   '間隔 10秒
  46.     'Do :    DoEvents:    Loop Until Time > xTime
  47.    '**********或是下式**********************
  48.     'Application.Wait Now + #12:00:09 AM#
  49.     '********************************
  50.     Next
  51.     MsgBox "ok"
  52. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# GBKEE


GBKEE大,可以了,萬分感謝,您真的是太強了

另外想問一下怎樣用QueryTable來抓取網頁資料
GOOGLE找到一題,您之前回答過的問題
http://forum.twbts.com/viewthread.php?tid=3218
可是好像無法執行,不知道那邊出了問題
奇摩網址問題?
如果用證交所的可以嗎

TOP

回復 2# Scott090


Scott090大,
您的這份巨集好像不行,
畫面出現
       
        106年01月 2330 台積電 日收盤價及月平均收盤價
        日期
        106/01/03
        106/01/04
        106/01/05
        106/01/06
        106/01/09
        106/01/10
        106/01/11
        106/01/12
        106/01/13
        106/01/16
        106/01/17
        106/01/18
        106/01/19
        106/01/20
        106/01/23
        106/01/24

TOP

回復 5# paul3063

請在模組最上方加入 Option 如下:

    Option Explicit
    Option Base 1
   
    Sub TWSEtest()
.....

end sub

TOP

回復 6# Scott090


這是跑出的結果
   
擷取.JPG
2017-12-23 06:35

TOP

回復 7# Scott090


Scott090大,可以了,謝謝。
可是我將裡面代碼作小修正,卻又不行了,
您可以再幫我看一下嗎?

     ' stock = "2330"          '設定代號
     ' yYear = "2017"          '設定年度
     ' mMonth = "01"           '設定月份
     
     stock = Range("A1")
     yYear = Range("B1")
     mMonth = Range("C1")

TOP

回復 6# Scott090


Scott090大,
剛剛發現是Cells.Clear這段的問題,這樣應該是沒有問題了,謝謝您。

TOP

回復 7# Scott090


Scott090大,
剛剛才發現您的方法只能下載單月份的,我要的應該是GBKEE大的那份答案結果,可以好幾個月合併的。

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題