(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料 (第12頁)

snare
個人積分：3046分
文章編號：64523539

3046分

樓主

2017-05-29 1:10

bioleon69 wrote:
您可能不知道,你在解釋觀念的時候
對於不懂程式的人,真的完全是在看外文一樣......(恕刪)

“因為是解釋，不是教怎麼寫程式”

不懂程式的，請copy就好，沒有基本程式能力的，我要如何解釋?

這裡的說明是針對=>略有vba基礎，對程式略懂以上的人
而這些人並不是不會寫程式，而是不知道用什麼方法去完成他的程式
只要有範例看，很快就能自行理解

這篇的目地是提供特殊技巧、特殊方法、讓人copy
不會寫程式的看完變高手，不是我本意
不懂的請找補習班，vba基礎能力只能自己加油

bioleon69

bioleon69
個人積分：63分
文章編號：64523656

63分

112樓

2017-05-29 1:40

snare wrote:
“因為是解釋，不是...(恕刪)

了解了,師傅
可是在您的教學,指導下
是會讓人想開始學習VBA的...
然後...
請問一下師傅

什麼狀況下,EXCEL的視窗,右上角的X按下去
會毫無反應(無法關閉)
但是,點擊其他的sheet之後,就又恢復正常,可以正常關閉
什麼情況下會變這樣?

小弟狀況是這樣

因為要下載的內容不多,所以選擇用IE的方式
.Visible也是true
(這樣比較帥)

但在某些狀況下
IE的視窗居然沒有跳出來,反而是在縮小視窗的情況下執行
(平常都會跳出來)

當這種狀況出現, EXCEL視窗就無法關閉
必須再次點擊其他的sheet才能關閉
跪求師父開示

snare

snare
個人積分：3046分
文章編號：64524130

3046分

樓主

2017-05-29 6:18

bioleon69 wrote:
什麼狀況下,EXCEL的視窗,右上角的X按下去
會毫無反應(無法關閉)
但是,點擊其他的sheet之後,就又恢復正常,可以正常關閉
什麼情況下會變這樣?

...(恕刪)
...(恕刪)

但在某些狀況下
IE的視窗居然沒有跳出來,反而是在縮小視窗的情況下執行
(平常都會跳出來)

當這種狀況出現, EXCEL視窗就無法關閉
必須再次點擊其他的sheet才能關閉

...(恕刪)

就是ie的問題，excel等不到回應，就會卡住

bioleon69 wrote:
因為要下載的內容不多,所以選擇用IE的方式
.Visible也是true
(這樣比較帥)
...(恕刪)

visible=true 是正確的選擇，有時候ie在背景執行會關不掉
至少還可以手動去關

除了ie之外還有可能是，用了太多 QueryTables.Add
資料不要時，儲存格又沒有清乾淨，造成背景連線太多，影響excel 效能

千萬不要以為 QueryTables 副程式跑完就沒事了
程式結束後，只要表格沒清除，記憶體是不會釋放乾淨的

如圖，正常時應該是沒有連線

更新10個股價，就會出現10個背景連線，連線愈多效能愈差

ie object、querytable 只適合用資料量很少的表格
資料多時，對excel效能、穩定上影響是明顯有感的
這也是我不建議使用的原因

當您的excel表格、資料量愈來愈多時
這個問題也會跟著變嚴重，發生次數跟著變多
也有可能會讓本來沒問題的副程式，容易出現記憶體不足的問題

xmlhttp winhttp post get 程式跑完就沒事了
除了表格內的資料外，不會留下任何影響效能的東西

p.s
2017/5/29 06:30
yahoo股價查詢似乎出了點問題，有部份股票代號查詢反應極慢
一筆資料有時要等到15秒以上
所以1樓範例也會跟著變慢，非程式問題不用擔心
因為在直接網頁上查詢也是一樣的問題，應該不久後就正常了

2017/5/29 20:08
yahoo 正常了
看來有必要為自己的程式加個當網路回應變慢時
自動切換到其它網站取資料比較好

bioleon69

bioleon69
個人積分：63分
文章編號：64526357

63分

114樓

2017-05-29 12:39

snare wrote:
visible=tr...(恕刪)

謝謝師傅
我的外部連線都有清除
不知道怎麼搞的
我在想想辦法
謝謝師傅提醒

來把昨天師傅教的winhttp代替點擊的方法測試看看

yahoo finance最近也改版了
速度會lag,不意外拉..

bioleon69

bioleon69
個人積分：63分
文章編號：64528401

63分

115樓

2017-05-29 17:00

師傅
弟子用您winhttp的程式碼練習,想代替ie來使用
結果一開始定義物件的時候就失敗了
小弟看不出來哪裡有問題
本來在ie的方法是ok的
還請師父指點1,2

Sub getpost()

Cells.Clear

Dim HTMLsourcecode, Url, Url_a, TempArray(), Table
Set HTMLsourcecode = CreateObject("htmlfile")

Url = "http://mops.twse.com.tw/mops/web/t56sb21_q3"
Url_a = "TYPEK=sii" & "&year=106" & "&smonth=5" & "&emonth=5" & "&sstep=1" & "&firstin=true"

With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.Send Url_a

HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
Set Table = HTMLsourcecode.all.tags("table")(12).Rows
Debug.Print HTMLsourcecode.all.tags("table")(12).innertext

snare

snare
個人積分：3046分
文章編號：64529174

3046分

樓主

2017-05-29 18:51

bioleon69 wrote:
結果一開始定義物件的時候就失敗了
小弟看不出來哪裡有問題...(恕刪)

post 方式，需根據各網站的原始碼，改寫程式碼

不是您把 ie object 用的網址，直接複製到winhttp中，就可以替換
請回頭再看一次範例，您可以發現71樓、75樓，寫法是不同

bioleon69

bioleon69
個人積分：63分
文章編號：64531115

63分

117樓

2017-05-29 22:43

snare wrote:
post 方式，需根...(恕刪)

感謝師傅指點
我在試試~
(我就是看75樓的)

yuehmao

yuehmao
個人積分：37分
文章編號：64531845

37分

118樓

2017-05-29 23:57

snare wrote:
因為71樓、75樓...(恕刪)

先謝謝 snare大大分享的這個範例^^
在下先收下來了,稍後再來研究內容看看。

bioleon69

bioleon69
個人積分：63分
文章編號：64532616

63分

119樓

2017-05-30 1:57

師傅我前面這樣是ok的嗎?
不過table還是無法定義

Sub getpost()
Cells.Clear

Dim HTMLsourcecode, Url, TempArray(), Table
Set HTMLsourcecode = CreateObject("htmlfile")

Url = "http://mops.twse.com.tw/mops/web/ajax_t56sb21"
Urla = "http://mops.twse.com.tw/mops/web/t56sb21_q3"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Urla
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.Send "step=1&TYPEK=sii&year=105&smonth=03&emonth=05&sstep=1&firstin=true"

HTMLsourcecode.body.innerhtml = convertraw(.responsebody)
Debug.Print HTMLsourcecode.body.innertext

snare

snare
個人積分：3046分
文章編號：64532670

3046分

樓主

2017-05-30 2:09

bioleon69 wrote:

不過table還是無法定義

...(恕刪)
...(恕刪)

.Send "step=1&TYPEK=sii&year=105&smonth=03&emonth=05&sstep=1&firstin=true"

HTMLsourcecode.body.innerhtml = convertraw(.responsebody)
Debug.Print HTMLsourcecode.body.innertext...(恕刪)

喔，真難得…居然寫出一半了 100分

debug.print 無法顯示的原因，請看這一篇
https://www.mobile01.com/topicdetail.php?f=511&t=5135532

table陣列定義錯誤，是因為“前3列”格子有合併，所以要寬度(欄)要抓第4列 or 更後面
不然會造成for next 迴圈，出現“超出範圍”的錯誤
不過，如果用“一次一格”的方式直接填入excel儲存格，就不會發生錯誤
陣列大小定義時，需要小心一點

範例網站：公開資訊觀測站
持股轉讓日報表http://mops.twse.com.tw/mops/web/t56sb21_q3

'====程式碼請放在“模組”裡=======================================

Sub getpost()

Cells.Clear

Dim HTMLsourcecode, Url, Url_a, Url_b, Table, TempArray()
Set HTMLsourcecode = CreateObject("htmlfile")

year_a = InputBox("年份(3碼數字)", , Year(Now) - 1911)
smonth = Format(InputBox("開始月份", , Month(Now) - 1), "00")
emonth = Format(InputBox("結束月份", , Month(Now)), "00")

Url = "http://mops.twse.com.tw/mops/web/t56sb21"
Url_a = "http://mops.twse.com.tw/mops/web/t56sb21_q3"
Url_b = "1&run=Y&step=1&TYPEK=sii&year=" & year_a & "&smonth=" & smonth & "&emonth=" & emonth & "&sstep=1&firstin=true"

ttt = Timer

With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url_a
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.Send Url_b

HTMLsourcecode.body.innerhtml = convertraw(.responsebody)

If InStr(HTMLsourcecode.body.innertext, "查詢過於頻繁") > 0 Then
Sheets("sheet1").Cells(1, 1) = "查詢過於頻繁,請稍後再試!!"
Exit Sub
End If

If Len(HTMLsourcecode.all.tags("table")(5).innertext) = 100 Then
Sheets("sheet1").Cells(1, 1) = "資料筆數過多，請縮小查詢範圍"
Exit Sub
End If

Set Table = HTMLsourcecode.all.tags("table")(10).Rows
ReDim TempArray(Table.Length - 1, Table(5).Cells.Length - 1)

For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
TempArray(i, j) = Table(i).Cells(j).innertext
Next j
Next i

End With

With Sheets("sheet1")
.Range(.Cells(1, 1), .Cells(Table.Length, Table(2).Cells.Length)) = TempArray()
End With

MsgBox "年份" & year_a & vbNewLine & "開始月份" & smonth & vbNewLine & "結束月份" & emonth & vbNewLine & "資料筆數" & Table.Length - 2 & "筆" & vbNewLine & "使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"

Set HTMLsourcecode = Nothing
Set Table = Nothing
Erase TempArray()

End Sub

Function convertraw(rawdata)

Dim rawstr
Set rawstr = CreateObject("adodb.stream")

With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
.Charset = "utf-8"
convertraw = .ReadText
.Close
End With

Set rawstr = Nothing

End Function

'==============================================
其它報表代號，請照下面俢改(請注意大小寫)

==========
TYPEK=???? 市場別
sii 上市
otc 上櫃
rotc 興櫃
pub 公開發行
=========

第1、2列，請自行另加程式碼處理美觀、排版問題

附加壓縮檔: 201712/mobile01-fc9ad35991a3e75eddf2b60aa48f8e21.zip