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


snare wrote:
把Acer_kewei 的表格+網址,合併成一個檔案,早上臨時寫,有bug請無視sorry

表單排版超隨便,也請無視
如果有人要重排一個表單給我這個美術白癡,非常歡迎,我再修改
...(恕刪)


謝謝S大的分享
snare wrote:
'範例說明:
'610樓的表格+613樓的程式=>合併...(恕刪)


樓主您好,此範例程式中有關 If ((Not Not Y) = 0) Or ((Not Not Q) = 0) Then 的條件判斷式,其中"Not Not Y"如何解讀與使用,能否請樓主簡單說明一下,謝謝
樓主您好

研究了223樓
看懂了 send 參數來源

send "ajax=true&input_stock_code=" & stock_id


function query(){
var code = document.getElementsByName("input_stock_code")[0].value;
var param = 'ajax=true&input_stock_code='+code;
setReport('result_st42.php?l='+LANG,param );
}

本想如法泡製用法櫃買三大法人上
給日期的參數

http://www.tpex.org.tw/web/stock/3insti/daily_trade/3itrade_hedge.php?&%20_

(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m[removed].insertBefore(a,m)
})(window,document,'script','//www.google-analytics.com/analytics.js','ga');

但好像相去甚多
只好再來找樓主指點迷津

另外我想取得 Google 的新聞頁面
例如:我先搜尋 緯創
在進入圖例一的畫面後
再按新聞的連結
會進入圖例二的畫面

但我用程式跑時
Ura = 'https://www.google.com/search?q=緯創'
回來的 response.text
經跟手動的比較後
發現那新聞的link會跟手動的不同
無法拿那個 link自動的進入我要的新聞頁面
請教這問題點是出在那 ?
謝謝您





activer wrote:
樓主您好,此範例程式中有關 If ((Not Not Y) = 0) Or ((Not Not Q) = 0) Then 的條件判斷式...(恕刪)


如果網站維護中,斷線、做壞事被擋ip
每種狀況程式中斷的位置會不一樣,斷線、擋ip,會停在.send

網站維護中or拿不到正確資料就會停在任意位置
(要看程式怎麼寫)

一般都檢查.responsetext有沒有資料
或是用on error goto 來判斷出了什麼問題
(例如:223樓 Debug.Print Err.Description 用錯誤碼來檢查)


範例中 y() q() 是用來放日期參數的陣列
為了避免太多種狀況要判斷
是停在.send、set... 其它(例如網站改版表格換位置,就會停在set table=)
直接用 on error resume next ,跳過所有錯誤

反正只要資料不對、網站出問題、改版
y、q,一定會沒東西

檢查沒定義大小的空陣列,會讓程式中斷





用not是一個就算不用on error 也不會讓程式中斷的小技巧

not 沒定義大小的空陣列=>傳回值 -1
not -1 =>傳回值 0

if (not q)=-1 也可以,0=false,-1=true

詳細請參考,not 運算子(範例)
https://docs.microsoft.com/zh-tw/dotnet/visual-basic/language-reference/operators/not-operator
JackLoh wrote:
本想如法泡製用法櫃買三大法人上
給日期的參數

http://www.tpex.org.tw/web/stock/3insti/daily_trade/3itrade_hedge.php?&%20_
...(恕刪)


用csv 、html 那2個按鈕的網址(選一個)




一、get

二、
csv=>
"http://www.tpex.org.tw/web/stock/3insti/daily_trade/3itrade_hedge_result.php?l=zh-tw&o=csv&se=EW&t=D&d=108/03/08&s=0,asc"

html=>
"http://www.tpex.org.tw/web/stock/3insti/daily_trade/3itrade_hedge_result.php?l=zh-tw&o=htm&se=EW&t=D&d=108/03/08&s=0,asc"

三、Referer=> "http://www.tpex.org.tw/web/stock/3insti/daily_trade/3itrade_hedge.php"

(點下可看大圖)



JackLoh wrote:
但我用程式跑時
Ura = 'https://www.google.com/search?q=緯創'
回來的 response.text
經跟手動的比較後
發現那新聞的link會跟手動的不同
無法拿那個 link自動的進入我要的新聞頁面
請教這問題點是出在那 ?
謝謝您

...(恕刪)


不知道,我試2種網址都可以正常開啟
google新聞網址後面那一大堆代碼大概是收集資料、點擊…等等用的(我猜的)
不用特別刪掉也正常


手動的
https://www.bnext.com.tw/article/52702/wistron-iphone-turn-profitable-2019

google新聞的
https://www.bnext.com.tw/article/52702/wistron-iphone-turn-profitable-2019&sa=U&ved=0ahUKEwjP1v2Q8K_hAhWkGqYKHflbAmIQqQIIEygAMAA&usg=AOvVaw03Sd_1mxthgtQWI-NTOFsJ





拿網頁內的一堆網址
一、getElementsByTagName("a")
二、找1裡面 .href
'=======================================

Sub getlinks()

Dim Url As String, HTMLsourcecode As Object, getxml As Object, links, h, t As String

Cells.Clear
Set HTMLsourcecode = CreateObject("htmlfile")
Set getxml = CreateObject("msxml2.xmlhttp")

Url = "https://www.google.com.tw/search?q=緯創&source=lnms&tbm=nws&start=0"
'Url = "https://www.google.com.tw/search?q=緯創&source=lnms&tbm=nws&start=1"
'Url = "https://www.google.com.tw/search?q=華映&source=lnms&tbm=nws&start=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"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send

HTMLsourcecode.body.innerhtml = .responsetext


Set links = HTMLsourcecode.getElementsByTagName("a")



For Each h In links
If Left(h.href, 17) = "about:/url?q=http" Then
i = i + 1
t = h.innertext
If t = "" Then t = Replace(h.href, "about:/url?q=", "")
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=Replace(h.href, "about:/url?q=", ""), TextToDisplay:=t
End If
Next


End With

ActiveSheet.Columns.AutoFit

Set HTMLsourcecode = Nothing
Set getxml = Nothing
Set links = Nothing



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

snare wrote:
用not是一個就算不用on error 也不會讓程式中斷的小技巧...(恕刪)

這是一個入門者不會知道的大技巧,謝謝
樓主您好:
以下的程式碼,均會在貼上工作表時產生第一列及第一欄空白(如圖),雖然在貼上工作表後可以" .UsedRange.Cut Destination:=.Range("a1")"指令刪除空白列,但小弟想請教是否有辦法在clipboard時,預先將空白列欄刪除後,再貼上工作表上?


######### 程式碼 #############
Sub getxml_clip()
Dim URL, HTMLsourcecode, getxml
Set HTMLsourcecode = CreateObject("htmlfile")
Set getxml = CreateObject("msxml2.xmlhttp")
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

URL = "http://jdata.yuanta.com.tw/z/zc/zca/zca_1102.djhtm" 'BASIC
Application.ScreenUpdating = False
ttt = Timer
Cells.ClearContents
DoEvents
With getxml
.Open "GET", URL, False
.send
Do Until .readyState = 4: DoEvents: Loop
HTMLsourcecode.body[removed] = .responsetext

With Clipboard
.SetText HTMLsourcecode.body[removed]
.PutInClipboard
End With
With Sheets("Sheet1")
.Cells(1, 1).Select
.PasteSpecial NoHTMLFormatting:=True
' .UsedRange.Cut Destination:=.Range("a1") '消除第一列及第一欄空白
.Range("a1").Select
End With
End With

Application.ScreenUpdating = True
Set HTMLsourcecode = Nothing
Set getxml = Nothing
Set Clipboard = Nothing
MsgBox "使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"
End Sub
##################################
謝謝您的回答
經指點後
一切都可行
除了讓我忙了好多天外
也著實對在網路上擷取資料
更加想進一歩了解
也就好奇的去探索這個 591 房產網站
奇怪的是網頁抓取下來後
重點的資訊都全不見
像圖二中 容邑PARK 的字串都會不存在
雖然把Request Header 完全比照chrome的資料還是無解
只會再來請您指點迷津
謝謝


https://sale.591.com.tw/?shType=list&price=0_1000&regionid=3










剛在 Python 上試用 selenium
倒是可以把資料抓下來
WinHttp 或者 IDHttp
都没辦法
雖然資料可以取得
但我還是很想了解為什麼
它可以讓 WinHttp 或者 IDHttp 抓不到資料
還是你有解決之道


activer wrote:
想請教是否有辦法在clipboard時,預先將空白列欄刪除後,再貼上工作表上?...(恕刪)


需先用文字處理函數(例如:replace)處理 .responsetext
把第一欄、第一列的html語法刪掉,再放入clipboard

建議用簡單一些的方式,不要把整個網頁放入clipboard
可改用21樓逐格寫入的方式,直接跳過第一欄、第一列

或是只取出表格放入clipboard
提示:
一、HTMLsourcecode.all.tags("table")(0)
二、613樓=>"股利政策"的程式碼


文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 158)

今日熱門文章 網友點擊推薦!