12
返回列表 上一主題 發帖

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

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-12-17 02:59 | 只看該作者

[發問] 如何快速將網頁資料抓到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
收藏 分享

Scott090

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
2#
發表於 2017-12-19 17:24 | 只看該作者
回復 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%

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

  48. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2017-12-19 18:34 | 只看該作者
本帖最後由 GBKEE 於 2017-12-21 17:37 編輯

回復 1# paul3063


試試看
  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

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
4#
發表於 2017-12-22 22:08 | 只看該作者
回復 3# GBKEE


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

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

TOP

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
5#
發表於 2017-12-22 22:11 | 只看該作者
回復 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

Scott090

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
6#
發表於 2017-12-23 06:31 | 只看該作者
回復 5# paul3063

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

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

end sub

TOP

Scott090

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
7#
發表於 2017-12-23 06:36 | 只看該作者
回復 6# Scott090


這是跑出的結果
   

TOP

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
8#
發表於 2017-12-23 14:01 | 只看該作者
回復 7# Scott090


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

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

TOP

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
9#
發表於 2017-12-23 14:09 | 只看該作者
回復 6# Scott090


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

TOP

paul3063

帖子
40 
主題
10 
精華
0 
積分
97 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
台灣台南 
註冊時間
2016-8-26 
最後登錄
2018-10-31 
10#
發表於 2017-12-23 14:24 | 只看該作者
回復 7# Scott090


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

TOP

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
12
返回列表 上一主題