• 69

(6/25小更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

(***此文只在mobile01發表,如轉貼到其它論譠、bolg,請附上來源網址,謝謝***)
(初學者,請從21樓開始看)

範例中的下載、載入(csv、html、json)、放入工作表…等等
大部份都是用不同方式寫的,主要是為了讓大家看看不同的寫法
基本上都可以混用的,無聊可以自己試看看
如果發現一些我沒注意到的bug,請無視,或自己修改
因為範例都是寫完就po上來,很少會再回頭檢查
至於排版、美觀方面,就請各位自行處理了


另外如果範例是逐格寫入資料的可以自行加上
Application.ScreenUpdating = False
有些我忘了加,資料量大時,速度會快很多


*2016*
(5/4 1樓文未增加中文亂碼解決方式,順便多加幾個doevents,21樓有簡易版程式碼)
*2017*
(5/10 45樓,“部份程式碼”,合併21樓範例,可快速載入csv檔)
(5/22 61樓,增加使用xmlhttp快速取得網頁純圖片網址,下載後插入excel範例)
(5/23 71樓,增加WinHttp post方法,可下載選取資料後網址不變,無法用get下載的網頁)
(5/26 75樓,增加鉅亨網個股歷史行情快速下載範例)
(5/27 71樓,增加一個變數,方便取得名稱)
(5/28 71樓、75樓,修正一個ReDim TempArray()不該發生的低級錯誤,忘了-1)
(5/28 107樓,增加臺灣證券交易所三大法人買賣超日報html下載範例,可和21樓比較看看有何不同)
(5/30 120樓,增加公開資訊觀測站持股轉讓日報表快速下載範例)
(5/30 123樓,增加臺灣證券交易所三大法人買賣超日報csv下載範例,可和107樓比較看看有何不同)
(6/03 149樓,增加台灣股市資訊網全自動範例,修正71樓錯誤)
(6/09 120樓,因公開資訊觀測站,新增了查詢次數限制,增加4行中斷用程式碼,避免錯誤發生)
(6/11 170樓,增加基本市況報導網站http://mis.twse.com.tw下載範例)
(6/13 170樓,增加幾行程式碼)
(6/14 175樓,小幅改寫1樓yahoo股價查詢程式碼)
(6/23 200樓,因臺灣證券交易所網頁改版,csv無法用123樓範例下載,新增另一種csv下載範例)
(7/1 200樓,增加PtrSafe,讓程式能在excel(64位元)中順利執行)
(7/5 219樓,使用比較特殊但較易懂的方式,改寫170樓程式碼)
(7/6 222樓,太無聊,拿219樓其中一個副程式,做一個表單)
(7/7 223樓,增加證券櫃檯買賣中心,上櫃統計報表個股年成交資訊html + csv下載範例)
(7/31 244樓,增加集保戶股權分散表查詢,“偽”多工處理方式範例)
(8/29 248樓,增加當網站檢查是用vba抓資料,會封鎖下載解決方式)
(10/26 256樓,因鉅亨網網址改變無法下載完整資料,請改用bioleon69(256樓)提供的範例)
(11/10 262樓,因鉅亨網“又”改版了,256樓範例失效,請參考peter624(262樓)的修改方式)
(11/11 266樓,沒有更新,無聊發文)
(11/15 269樓,增加凱基證券,每日收盤價下載範例)
(11/16 271樓,增加finance.yahoo.com,歷史資料下載範例)
(11/17 272樓,增加finance.yahoo.com,大量下載範例)
(11/21 274樓,增加finance.yahoo.com,不下載csv檔,改抓網頁範例)
(12/31 285樓,增加www.nvesto.com 摩根大通買賣超下載範列)
*2018*
(1/31 269樓,增加另一種urlencode副程式的寫法)
(2/1 294樓,增加台灣股市資訊網現金流量六大報表下載範例,可和149樓比較看看有何不同)
(2/5 298樓,再寫一篇,臺灣集中保管結算所(保戶股權分散表查詢)範例)
(2/9 303樓,增加麥克連大師的Excel 8大指標資料下載範例(整理總表功能保留,詳內文))
(2/11 306樓,增加玩股網wantgoo券商進出買超vs買超排行,資料下載範例)
(2/18 308樓,放假無聊更新,用vba把yahoo股市中的k線圖(走勢圖),重新做一個整合網頁)
(2/22 306樓,更新306樓,增加從玩股網取得最後一天交易日期的程式碼)
(3/5 303樓,8大指標資料下載程式碼中加入一些沒用的垃圾文字,避免卡巴把檔案當成病毒)
(3/24 328樓,因集保戶股權分散表查詢,網址、查詢方式改變,298樓範例失效,更新程式碼)
(3/25 332樓,無聊發文,昨天更新的程式碼,也許明天就不能用了,網頁又在改版中)
(3/25 328樓,再次更新(2018-03-25 22:20 328樓部份程式碼)
(3/26 328樓,再次更新部份程式碼…)
(3/27 328樓,因網站編碼恢復正常,取消使用轉碼副程式)
(4/1 348樓,修正244樓、328樓,Delaytick()副程式)
(4/9 358樓,將328樓的範例,加上Access資料庫,線上查詢+離線查詢+自訂股票清單)
(4/11 369樓,法人持股明細下載範例,請安靜使用)
(4/14 373樓,因網頁改版,更新328樓、358樓部份程式碼)
(5/11 413樓,簡單介紹一下新版excel 的powerquery 來代替 舊版 web匯入)
(5/16 419樓,增加臺灣銀行牌告匯率下載範例,可和269樓,比較看看有何不同)
(6/10 425樓,增加中油公司車用汽、柴油公告牌價,csv下載範例)
(6/18 430樓,自營商買賣超明細(djinfo)下載範例)
(6/21 431樓,如何在userform1中,動態產生控制項的簡單範例)
(8/2 440樓,增加 xmlhttp 無法在 XP 存取https(新版tls加密連線)解決方式)
(8/18 449樓,沒情人在家發呆寫程式,順便修正328、358樓改版後網址)
(8/22 456樓,增加,鉅亨網(類股成交金額漲跌幅及市值比較)下載範例)
(8/28 461樓,股權分散表改版,請參考yuhuahsiao(461樓)的修改方式,或回449樓下載)
(9/20 358樓,補充關閉錯誤檢查的方式)
(11/13 303樓,因臺灣期貨交易所網頁改版,更新gettaifex()副程式中的6個網址)
(11/28 506樓,yahoo 股市改版,表格位置變動,僅提示,程式碼請自行練習修改)
(12/21 506樓,yahoo 股市再次改版,表格位置變動,請參考506樓,自行練習修改)
(12/22 533樓,unicode(6碼)轉中文範例)
*2019*
(1/26 566樓,增加使用vba開啟外部程式,並輸入按鍵、文字範例)
(2/25 585樓,增加國發會景氣指標查詢系統,下載範例)
(3/28 610樓,投資理財版的專家Acer_kewei,分享了一個整理好的表格)
(3/28 613樓,因goodinfo網站改版,修正2017年149樓程式碼)
(3/28 613樓,文末增加610樓表格下載,加入一些更新用的程式碼)
(3/29 613樓,更新程式碼,加入標題、股利政策下載、簡單排版一下財務比率表)
(4/1 620樓,合併610樓+613樓)
(4/7 631樓,增加591房屋,下載範例)
(4/7 632樓,620樓漏了一個表格,請參考yuhuahsiao(632樓)的修改方式,或回620樓下載)
(4/18 645樓,增加如何用vba控制308範例中的main.html下拉式選單範例)
(6/25 666樓,臺灣證券交易所改版,簡單說明一下修改方式)

解決方式有很多
一、分析真實查詢位置
二、webquest iqy
三、csv table
四、ie object
五、microsoft.XMLHTTP
六、msxml2.xmlhttp
七、access sql
八、adodb stream
九、其它

可以google到的範例,基本上都是前4個,因為比較容易copy、改寫
不過第四個有個問題就是效率太差,因為要使用 ie 來開,抓一筆資料1~10秒不等

我使用第六種,不需開ie直接抓取資料

這樣只需要載入網頁原始碼,再把表格部份取出
可有效提高速度,還比excel直接用web匯入還快很多很多

我的電腦I7+excel 2007,在網路正常的情況下
yahoo 100筆(每筆1個表格,1列資料),約8~15秒
鉅亨 100筆(每筆4個表格,16列資料),因為要新增工作表大約20~35秒
如果資料放在同一工作表,改成只抓一個表格,時間就跟yahoo差不多

(目前最多只試到1500筆,再多不確定是否正常,請自行測試)
' yahoo (2016/3/21 把資料分散,增加副程式的效率,提升查詢速度)
'====================================================
Global TempArray()
Sub fake_Multiplex()

t = Timer
lastrow = Sheets("stock").Range("a1").CurrentRegion.Rows.Count
Sheets("stock").Range("b2:l" & lastrow).Clear: Range("n1") = ""
ReDim TempArray(lastrow - 2, 10)
If lastrow Mod 5 > 0 Then j = Int(lastrow / 5) + 1 Else j = Int(lastrow / 5)

For i = 1 To j
If i = 1 Then firstdata = 2 Else firstdata = (i - 1) * 5 + 1
If i = j Then
lastdata = lastrow
Sheets("stock").Range("n1") = lastrow - 1 & " stock loading ok"
Else
lastdata = (i - 1) * 5 + 5
Sheets("stock").Range("n1") = "Loading " & Round((i / j) * 100) & "%"
End If
Call getstock(firstdata, lastdata)
Next i

Sheets("stock").Range("b2:l" & lastrow).Value = TempArray()
Erase TempArray()
Sheets("stock").Cells.EntireColumn.AutoFit
Debug.Print Timer - t

End Sub

Sub getstock(firstdata, lastdata)

Dim URL, HTMLsourcecode, GetXml

For k = firstdata To lastdata

DoEvents
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
URL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets("stock").Cells(k, 1)

With GetXml
.Open "GET", URL, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send


HTMLsourcecode.body.innerhtml = .responsetext
'網站有亂碼時,把上面這一行刪掉,改用下面這一行
'HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)

Set Table = HTMLsourcecode.all.tags("table")(6).Rows

For i = 1 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 2

If i = 1 And j = 0 Then
TempArray(k - 2, j) = Mid(Split(Table(i).Cells(j).innertext, Chr(13) & Chr(10))(0), 5, Len(Split(Table(i).Cells(j).innertext, Chr(13) & Chr(10))(0)))
Else
TempArray(k - 2, j) = Trim(Table(i).Cells(j).innertext)
If InStr(TempArray(k - 2, j), "▽") > 0 Or InStr(TempArray(k - 2, j), "▼") > 0 Then Sheets("stock").Cells(i + (k - 1), j + 2).Font.Color = -11489280
If InStr(TempArray(k - 2, j), "△") > 0 Or InStr(TempArray(k - 2, j), "▲") > 0 Then Sheets("stock").Cells(i + (k - 1), j + 2).Font.Color = -16776961
End If

Next j
Next i

End With

Set HTMLsourcecode = Nothing
Set GetXml = Nothing

Next k


End Sub
' ==========================================================



' 鉅亨 (2016/3/21 把資料分散,增加副程式的效率,提升查詢速度)
'===============================================
Global TempArray(), Stockname()
Sub fake_Multiplex()

ttt = Timer
Sheets("stock").Range("e1") = ""
If Worksheets.Count > 1 Then Call delsheet
lastrow = Sheets("stock").Range("a1").CurrentRegion.Rows.Count
ReDim Stockname(lastrow - 2), TempArray(lastrow - 2)
If lastrow Mod 5 > 0 Then j = Int(lastrow / 5) + 1 Else j = Int(lastrow / 5)

For i = 1 To j
doevents
If i = 1 Then firstdata = 2 Else firstdata = (i - 1) * 5 + 1
If i = j Then
lastdata = lastrow
Sheets("stock").Range("e1") = lastrow - 1 & " stock loading ok"
Else
lastdata = (i - 1) * 5 + 5
Sheets("stock").Range("e1") = "Loading " & Round((i / j) * 100) & "%"
End If
Call getstock(firstdata, lastdata)
Next i

For i = 0 To lastrow - 2
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Stockname(i)
Sheets(Stockname(i)).Range("a1:i19").Value = TempArray(i)
Sheets(Stockname(i)).Cells.EntireColumn.AutoFit
Next i

Erase TempArray
Sheets("stock").Select
Debug.Print Timer - ttt

End Sub

Sub getstock(firstdata, lastdata)

Dim URL, HTMLsourcecode,GetXml
Dim TempArray2(20, 8)

For k = firstdata To lastdata

Set HTMLsourcecode = CreateObject("htmlfile")
set GetXml=CreateObject("msxml2.xmlhttp")
URL = "http://www.cnyes.com/twstock/Technical/" & Sheets("stock").Cells(k, 1) & ".htm"

With GetXml

.Open "GET", URL, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send



Stockname(k - 2) = Replace(Right(Split(.responsetext, "_技術指標")(0), 11), Chr(13) & Chr(10), "")

HTMLsourcecode.body.innerhtml = .responsetext

For m = 1 To 4

Set Table = HTMLsourcecode.all.tags("table")(m).Rows
For i = 0 To Table.Length - 1
doevents
For j = 0 To Table(i).Cells.Length - 1
TempArray2(i + ((m - 1) * 5), j) = Trim(Table(i).Cells(j).innertext)
Next j
Next i

Next m

End With

TempArray(k - 2) = TempArray2
Erase TempArray2
Set HTMLsourcecode = Nothing
set GetXml=nothing

Next k

End Sub
Sub delsheet()

Dim delsheet As Worksheet
Application.DisplayAlerts = False
For Each delsheet In Worksheets
If delsheet.Name "stock" Then delsheet.Delete
Next delsheet
Application.DisplayAlerts = True

End Sub

' ==========================================================

這些程式碼,單純只是我突然想複習一下很久沒用msxml2的語法,順便更新算一下自己股票損益
雖然是測試版,反正都寫好了,也懶得最佳化處理縮短優化程式碼
想拿就拿去用吧,檔案也上傳了,其它網站只要修改小地方就行
根據我的觀察,好像有不少人想要

萬一網頁改版無法匯入,請自行想辦法調整
我有特別讓程式碼很容易修改,剩下的請自行研究

如果有會1~8種之外,其它更好方法的高手,能幫忙修改提升程式效率
歡迎討論

***但如果是只想要我幫忙修改、拿現成的,我一律不回***

p.s 這是取代 excel web 匯入用的,不是拿來抓“數萬筆”資料用的
雖然要用也是可以啦,但大量查詢下,說不定暫時會被擋ip or 回應變慢

上班用這種方式偷看股票被發現,後果自行承擔,別怪我

這是少量股票更新用的,想一次下載全部收盤資料的,請跳到269樓看範例

(yahoo + 鉅亨)
(2017/05/04 小更新,增加亂碼處理方式,順便多加幾個doevents,)
附加壓縮檔: 201705/mobile01-f6724b4625b8dc97698a45375733b69b.zip

(只有yahoo,鉅亨用不到,懶的改了)
(2016/3/27 更新,試寫一個用 script 方式抓資料的程式碼)
程式碼就不貼了,反正沒人看,想看的自己下載
附加壓縮檔: 201603/mobile01-ee273354e317f442fa850e52c524c978.zip
p.s 此版本會在windwos\temp 產生大量暫存檔
不推薦使用,單純為了試試另一種方式的瑕疵作品
只是為了試試新方法,寫完沒整理就po上來了,所以穩定性極差

建議用2016/3/21的版本就好(更新到2017/05/04)
cpu使用率低、穩定性高,連續抓1500筆都不會出問題
(不過,能有1500筆股票的,也非常人,不會想用這種小東西)
基本上不會再更新了,因為自己的股票還不到30筆
這些只是無聊試試不同方法,練習的小品程式
而且主要目地只是代替excel web匯入,沒有抓上千筆資料的需求

'=======================================================================
5/4補充,如果拿這個範列去抓別的網站資料
有些網站因為編碼的關係,抓下來的資料,中文會變亂碼


這行
HTMLsourcecode.body.innerhtml = .Responsetext
改成
HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)

程式碼內多加上一個function
正常的網站就不要用這個function了,可以節省一點點處理時間

(密技,快速對大量文字改編碼類型)

Function convertraw(rawdata)

Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
'繁體通常轉成big5就可以了,簡體通常是gb2312
.Charset = "big5"
convertraw = .ReadText
.Close
End With
Set rawstr = Nothing

End Function
2016-03-14 20:04 發佈
snare wrote:
...
六、msxml2.xmlhttp
...
我使用第六種,不需開ie直接抓取資料
...


感謝分享

不過,有些網頁的資料是 load 之後,有一小段 Ajax 會再去抓資料之後 才算真的完成,這第六種方法可能會抓不到資料
Wei_1144 wrote:
有些網頁的資料是 load 之後,有一小段 Ajax 會再去抓資料之後 才算真的完成...(恕刪)


我對網頁設計不熟,停留在排版階段,但 yahoo 鉅亨 測試上是沒問題的

因為我是等整網頁載入完成之後 => Do Until .readyState = 4: DoEvents: Loop
讀入全部的原始碼,再取出表格內容
如果真的有這個問題也不難解決,多增加等待時間就好
或是分析ajax看看是去那裡抓資料

您有先下載附檔跑看看嗎??
snare wrote:
第四個有個問題就是效率太差,因為要使用 ie 來開,抓一筆資料1~10秒不等


這個也不是沒有解法

遇過一個國外的網站 反應速度很慢,回應一筆資料大約需要30秒,偏偏要抓的資料筆數又很多

後來就用 Excel VBA 寫了一個類似 Celery 之類的工具,在 Excel 中使用 VBA 操作 Windows Script Host 開 multi-processes 去抓資料,幾分鐘就抓完了
Wei_1144 wrote:
遇過一個國外的網站 反應速度很慢,回應一筆資料大約需要30秒...(恕刪)


請問是網站特別讓回應變慢 or 網路回應慢???

可以給我網站嗎,我想試試如果用 msxml2.xmlhttp 不跑多工的話,能不能行的通
snare wrote:
我對網頁設計不熟,停留在排版階段orz,但 yahoo 鉅亨 測試上是沒問題的

因為我是等整網頁載入完成之後 => Do Until .readyState = 4: DoEvents: Loop
讀入全部的原始碼,再取出表格內容

您有先下載附檔跑看看嗎??


我沒有下載跑跑看,不過我了解你程式的作法,既然你跑過,應該沒有問題

"Do Until .readyState = 4" 的問題,在於遇到一些 https 的網頁會 hang 住,除非 IE config 中設定 為信任的網域(但是不安全)。 網路上有討論,我一時之間找不到資料。
Wei_1144 wrote:
"Do Until .readyState = 4" 的問題,在於遇到一些 https 的網頁會 hang 住 ...(恕刪)


我用 ie object + readyState = 4 常常發生,用yahoo 股市測試時就當到我受不了
解決方式是加入計時,超過時間就跳到下一筆,再回頭重抓
或是
檢查載入的資料例如有 1~100 ,我只要1、2、3,拿到後直接關閉ie,跳下一筆

相同網站改用 msxml2.xmlhttp + readyState = 4 ,只有載入sourcecode,跟ie比起來,效率至少快50倍
(ie.object 實測後,同樣100筆資料)

msxml2.xmlhttp + readyState = 4,最多只遇到網頁回應稍慢而己,還沒遇過停止回應
snare wrote:
請問是網站特別讓回應變慢 or 網路回應慢???

可以給我網站嗎,我想試試如果用 msxml2.xmlhttp 不跑多工的話,能不能行的通

某個國家的國家圖書館,我去抓書目資料,我覺得是因為他們系統或網路的關係,因為每個動作的回應都不快

我想不用試了,每個網站的對策都不同,遇過前300筆都很快,一旦超過三百筆就變得超慢的

還有的網站一旦發現抓 特定IP每筆request的間隔時間太短 就會擋。很多樣化。
Wei_1144 wrote:
我想不用試了,每個網站的對策都不同,遇過前300筆都很快,一旦超過三百筆就變得超慢的
還有的網站一旦發現抓 特定IP每筆request的間隔時間太短...(恕刪)


說到痛點了,這些我以前寫程式時都遇過,不過對現在的我都不是問題了
有大量抓資料需求的,請花錢請人寫,或是自己想辦法google程式碼
就讓我藏私一下,免費的,這樣就很好了

您願意下載檔案跑看看,給點意見嗎?是否有再加速的可能性?
snare wrote:
您願意下載檔案跑看看,給點意見嗎?是否有再加速的可能性?

你好像是一筆一筆抓,這樣應該會被 Yahoo ban。

Yahoo 台灣股市 每天約有 15600 筆股票權證 收盤資料,全部這樣抓 沒有多久就會被 ban 了,而且這樣也太花時間了。
  • 69
限制級
您即將進入之討論頁 需滿18歲 方可瀏覽。
根據「電腦網路內容分級處理辦法」修正條文第六條第三款規定,已於該限制級網頁,依台灣網站分級推廣基金會規定作標示。
評分
複製連結
請輸入您要前往的頁數(1 ~ 69)