麻辣家族討論版版 - Powered by Discuz! Board

標題: 證交所全部上市股票交易明細下載 [打印本頁]

作者: white5168 時間: 2012-8-3 00:35 標題: 證交所全部上市股票交易明細下載

花了一些時間以Excel VBA寫了一個下載交易明細Debug version,主要在做時間的優化處理,Release version可能需要再多點時間進行參數final duel
現在附上使用python與Excel VBA執行完成的圖案,python執行的時間2603秒,Excel VBA執行時間7598秒(未優化前),兩者相差約2.9倍
這兩個都是在有線網路20M/4M, 雙核心雙執行緒2G Hz CPU, 4G RAM, XP OS SP3規則所跑出來的結果
也試過在無線3.5G, i7四核心8執行緒 2.3G Hz CPU, 4G RAM, win7 OS SP1跑出約相差4倍的差距,所以如果執行環境越差,跑出來的結果相差越大
目前經過幾天的壓力測試,結果在可接受的範圍內,雖然已經努力進行優化了,但整體花費時間比起python的時間,仍需要做優化
至於下載明細所儲存的檔案格式在之後如使用者有需要再做調整

目前該Excel VBA 交易明細.xls 為V1.0.0.1 T01
其功能如下
1.開啟時會自動將當天的日期設定,並將欲取得的上市股票ID編號重頭開始(這裡是2)
2.下載儲存交易明細日期與上市股票ID編號,可自行設定
3.當資料取得過程發生在某一個網頁有問題時,會自動記錄,以供再次下載有問題股票之用
4.當網頁開啟有問題時,及遠端證交所伺服器過忙碌時,將會進行Retry直到取得資料
5.當Retry 5次無法下載市股票ID的總頁數網頁時,會記錄該日期與股票以供參考
6.自動記錄有交易日期各股票在證交所網頁上的總頁數
7.會自動將股票ID與交易明細儲存為CSV檔

由於是Debug version,若是使用上有任何問題歡迎提出或是需要添加何種功能也可以提出討論

作者: lalalada 時間: 2012-8-3 01:05

回復 1# white5168

感謝分享!!
雖然我權限不到還無法拜讀
不過應該快了...
想先問一下下載下來的檔案大概多大呢(總共)?
有這方面的問題想跟大大請教

作者: HSIEN6001 時間: 2012-8-3 08:07

回復 1# white5168

分析的很詳細,謝謝!
拜讀了大作,希望大師多點python方面的教學指導
先別計較開不開 [專屬版] ; 語言這條路,五花八門
只要有門路,相信大家都很樂意學習
更不會計較在哪裡學習

相信你是[愛之深,責之切]
否則你不會繼續在這裡討論python語言的功力

我很外行,說的不貼切還請海涵
但有人願意分享教學 or 解決語法bug的困擾
才是這條路的前進動力

否則只能望著大師的作品而 "捶心肝"
沒法真的入門,連學習的動力都沒有說

還請大大繼續 [指導] 入門及其他分享
~~感恩!

作者: tsuneng 時間: 2012-8-3 23:21

雖說基礎不足,吸收有限,但非常感謝大大慹心分享敎學.!!!!

作者: devidlin 時間: 2012-8-4 10:42

回復 1# white5168

你好，是可以用，可以寫說買賣大於1000張以上的資料，另外可以下載五天前的資料嗎?謝謝。

作者: HSIEN6001 時間: 2012-8-4 10:44

本帖最後由 HSIEN6001 於 2012-8-4 10:47 編輯

回復 1# white5168

請問大師 --->(ＰＳ：三人行必有我師！在我眼裡，在這邊的都是導師。)
因末學用無線3.5G下載,時常會卡住(停頓).正在找語法bug ,或僅是流量不穩定問題！！

在您的語法內(針對下載部分),有幾個疑問先請教
Application.DisplayAlerts = False 'False 不想被提示跟警報,例如:覆蓋的默認---->在此網頁有特別作用?? 範例中尚未看到這應用;我RUN會卡住(停頓).是因為少這段?
....(省略)....
.RefreshStyle = xlInsertDeleteCells '插入新資料,原資料右移----->????為何不是用覆蓋的方式
....(省略)....

On Error Resume Next
Do
Err.Clear
.Refresh BackgroundQuery:=False '刷新返回查詢(執行更新)
If Err.Number Then '------->是指刷新查詢更新,延遲的等候？！
Application.Wait Now + TimeValue("00:00:01")
End If
Loop Until Err.Number = 0　　　'---->迴圈處理直到err=0 才算完成 (經典)
'If Err.Number <> 0 Then Err.Clear: MsgBox Err.Number '被免資料抓取不成功,而顯示訊息
On Error GoTo 0
End With
If Err.Number = 0 Then
Application.DisplayAlerts = True 'True 需提示跟警報？ ---->True 及 Flase 的應用,還不是很理解.只是爬文所得的大意,望請稍加說明
Exit Sub
End If

複製代碼

作者: GBKEE 時間: 2012-8-4 11:32

本帖最後由 GBKEE 於 2012-8-5 09:23 編輯

回復 1# white5168
測試完成圖
[attach]12015[/attach]

2012/8/5 更新程式碼

Option Explicit
Dim SH(1 To 2) As Worksheet, IE As Object
Dim xltheCsv As String, xLMsg As String, Rng As Range
Const xlPath = "D:\Test1\" '可修改CSV存檔的路徑
Sub 全部日報表() '查詢全部日股票報表
Dim T As Date
存檔資料夾
T = Time
xLMsg = "" '紀錄股票代號沒報表
上市股票代號 '取得最新上市股票代號表
網頁 '開啟網頁
Set Rng = SH(1).[A3] '股票代號
Do
Rng.Select
ActiveWindow.ScrollRow = Rng.Row - 1
Application.ScreenUpdating = False
If Rng.Offset(, 1) <> "" Then 匯入日報表 Trim(Split(Rng, " ")(0)) 'Trim(Split(Rng, " ")(0)):股票代號
Set Rng = Rng.Offset(1) '下一個股票代號
Application.ScreenUpdating = True
'Loop Until Rng = "" '<-含上市股票,上市認購(售)權證,受益證券-不動產投資信託--
Loop Until Rng.Offset(, 1) = "" '<-僅有上市股票 : B欄是空白時離開迴圈
SH(1).Parent.Close 0 '關閉最新上市股票代號表
IE.Quit '關閉網頁
Set IE = Nothing
Set Rng = Nothing
MsgBox "全部日報表下載完成費時" & Format(T - Time, "HH時mm分ss秒") & Chr(10) & xLMsg
If xLMsg <> "" Then 無報表紀錄
End Sub
Sub 查詢股票日報表() '查詢單一股票日報表
Dim 股票代號 As String, 股票 As String, T As Date
存檔資料夾
xLMsg = ""
Do While 股票代號 = ""
股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
If 股票代號 = "" Then End
Loop
T = Time
網頁
匯入日報表股票代號
IE.Quit
Set IE = Nothing
If xLMsg <> "" Then
MsgBox xLMsg
無報表紀錄
Exit Sub
Else
股票 = Replace(Replace(xltheCsv, ".CSV", ""), xlPath, "")
MsgBox 股票 & Chr(10) & "下載時間" & Format(T - Time, "HH時mm分ss秒") _
& Chr(10) & "存檔路徑: " & xlPath
End If
Workbooks.Open xltheCsv
ActiveSheet.Cells.EntireColumn.AutoFit
End Sub
Private Sub 匯入日報表(股票代號 As String) '處裡傳送來的 --股票代號--
Dim Xall As Integer, SubMsg As String, SubRng As Range
Xall = Val(報表頁數(股票代號)) '傳回報表頁數
If Xall = 0 Then '無報表頁數: 報表不存在
If Rng Is Nothing Then
SubMsg = "[ " & 股票代號 & " ] 無報表"
Else '全部日報表程式: 含股票名稱
SubMsg = Rng & " 無報表"
End If
xLMsg = IIf(xLMsg <> "", xLMsg & Chr(10) & SubMsg, SubMsg)
Exit Sub
End If
Set SH(2) = Workbooks.Add(1).Sheets(1) '新增一活頁簿
With SH(2).QueryTables.Add(Connection:="URl;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=All_" & Xall, Destination:=SH(2).Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "4,""table2"""
On Error Resume Next '程式還有錯誤不處裡
Do
Err.Clear '清除錯誤值
.Refresh BackgroundQuery:=False 'Refresh 失敗會有錯誤值
Loop While Err > 0 '有錯誤值繼續迴圈直到 Refresh 成功
On Error GoTo 0 '有錯誤值不處裡
'消除: On Error Resume Next 如還有錯誤不處裡會影響運行的正確性
SH(2).Names(.Name).Delete
End With
If Xall > 1 Then '處裡頁數 > 1 '清理空白列及每頁的欄位
With SH(2)
Set SubRng = .Range(.[A6], .Cells(.Rows.Count, "A").End(xlUp))
SubRng.Replace "序", "", xlWhole
SubRng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
End With
End If
xltheCsv = xlPath & Format(SH(2).[B1], "yyyy_mm_dd ") & SH(2).[F1] & ".CSV"
On Error GoTo xlerr 'xltheCsv 已開啟會有錯誤到xLerr處裡
If Dir(xltheCsv) <> "" Then Kill xltheCsv
On Error GoTo 0
SH(2).Parent.SaveAs xltheCsv, xlCsv
SH(2).Parent.Close True
Exit Sub
xlerr:
If Err = 70 Then
Workbooks(Format(SH(2).[B1], "yyyy_mm_dd ") & SH(2).[F1] & ".CSV").Close 0 '關閉xltheCsv 可清除錯誤
Resume '反回錯誤行
Else
MsgBox "錯誤值 " & Err & " 需偵錯!!"
End
End If
End Sub
Private Sub 上市股票代號() '下載最新代號 ( 上市股票,上市認購(售)權證,受益證券-不動產投資信託 )
Dim SstockId As String
SstockId = "URL;http://brk.twse.com.tw:8000/isin/C_public.jsp?strMode=2"
Set SH(1) = Workbooks.Add(1).Sheets(1)
With SH(1).QueryTables.Add(SstockId, SH(1).[A1])
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.Refresh 0
End With
End Sub
Private Sub 網頁() '開啟網頁
Dim Url As String
Set IE = CreateObject("InternetExplorer.Application")
Url = "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
With IE
'.Visible = False ''可以不顯示 IE
.Visible = True
.Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
End With
End Sub
Private Sub 存檔資料夾() '沒有CSV存檔的路徑: 設立CSV存檔的路徑
If Dir(xlPath, vbDirectory) = "" Then MkDir xlPath
End Sub
Private Sub 無報表紀錄() '工作表上紀錄沒報表的股票代號
With ThisWorkbook.Sheets(1)
.Activate
If .[A1] = "" Then .[A1] = "股票: 無報表"
.Cells(.Rows.Count, "a").End(xlUp).Offset(1).Resize(UBound(Split(xLMsg, Chr(10))) + 1) = Application.Transpose(Split(xLMsg, Chr(10)))
End With
End Sub
Private Function 報表頁數(Sstock_N0 As String)
Dim element As Object
On Error GoTo xlerr:
xlAgain:
Set element = IE.Document.getElementsByName("txtTASKNO")
element.Item(0).Value = Sstock_N0
Set element = IE.Document.getElementsByName("btnOK")
element.Item(0).Click
With IE
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
End With
Set element = IE.Document.getElementsByName("sp_ListCount")
報表頁數 = element.Item(0).innertext
Exit Function
xlerr: '處裡網頁中斷
IE.Quit
網頁
Err.Clear
GoTo xlAgain
End Function

複製代碼

作者: HSIEN6001 時間: 2012-8-4 12:01

回復 7# GBKEE

好棒!執行速度超快的!
報告:
目前有個中斷點在代號1414
??

作者: HSIEN6001 時間: 2012-8-4 12:06

回復 8# HSIEN6001

附註斷點: 報表頁數 = element.Item(0).innertext

作者: devidlin 時間: 2012-8-4 13:46

回復 7# GBKEE

你好，完整excel檔案可以分享嗎?謝謝。

作者: GBKEE 時間: 2012-8-4 14:30

回復 8# HSIEN6001
回復 9# HSIEN6001
請問中斷時的錯誤值是多少

回復 10# devidlin
複製程式碼後
執行先執行 Sub 查詢股票日報表() 再試試 Sub 全部日報表()

作者: HSIEN6001 時間: 2012-8-4 14:36

回復 11# GBKEE

錯誤數值在哪裡看?!
資料完整下載到1413後--->1414 err在如上述之位置出現偵錯點

現在正重新執行測試,卻早已超過1414代號
不知道為何會中斷

我自己的先前的下載,也常如此;反而PM9:00之後
跑的很正常

我想....是否3.5G的問題?!

作者: white5168 時間: 2012-8-4 14:41

回復 HSIEN6001

附註斷點: 報表頁數 = element.Item(0).innertext
HSIEN6001 發表於 2012-8-4 12:06

這個問題在我的程式碼裡有防範了,原因很簡單,有的時候使用set物件時,如果IE沒有開完整,將會導致無法取得對應的物件,此時便會發生無法取得頁數的問題,看來關於這一點,版主要再多try一下,這個發生點不是每次都會發生在相同的位置,應該多增加防範,如果無法順利取得頁數或是set物件發生問題時,要進行Retry

作者: HSIEN6001 時間: 2012-8-4 14:51

回復 13# white5168

扼脕!又斷了
我的3.5G這麼不穩!

其實W大的,我一直都不能正常使用
末學還有很多看不懂,所以先學看語法
偵錯在 If TestFolder = False Then TestObj.CreateFolder (CSVfolder)
[attach]12016[/attach]

作者: c_c_lai 時間: 2012-8-4 14:52

回復 11# GBKEE
無論是先執行查詢股票日報表()，而後執行全部日報表()，
亦或單獨先執行全部日報表()，結果是一致的。
差別只在於中斷時之讀取股票代碼位置之多寡而已。
出現的錯誤訊息如下：
[attach]12017[/attach]

作者: HSIEN6001 時間: 2012-8-4 15:01

回復 13# white5168

G大這裡指令很完整,應該不是頁數回覆問題 (我也測試過這個頁面回覆)
      Do While .Busy Or .ReadyState <> 4 ---->這裡(4)文檔已經解析完畢 , 用戶端可以接受返回消息
         DoEvents
      Loop

作者: HSIEN6001 時間: 2012-8-4 15:11

比較像是W大後面敘述的
set物件發生問題時,要進行Retry

先前還笨笨的用
Sleep 4000 '1000豪秒=1秒
去應對

作者: GBKEE 時間: 2012-8-4 15:19

本帖最後由 GBKEE 於 2012-8-4 17:07 編輯

回復 13# white5168    謝謝你的提醒指教
回復 15# c_c_lai          回復 16# HSIEN6001
white5168  的指教修改如下

Private Function 報表頁數(Sstock_N0 As String)
Dim element As Object
On Error GoTo xlerr:
xlAgain:
Set element = IE.Document.getElementsByName("txtTASKNO")
element.Item(0).Value = Sstock_N0
Set element = IE.Document.getElementsByName("btnOK")
element.Item(0).Click
With IE
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
End With
Set element = IE.Document.getElementsByName("sp_ListCount")
報表頁數 = element.Item(0).innertext
Exit Function
xlerr: '處裡網頁中斷
IE.Quit
網頁
Err.Clear
GoTo xlAgain
End Function

複製代碼

作者: white5168 時間: 2012-8-4 16:15

回復  white5168    謝謝你的提醒指教
回復  c_c_lai          回復  HSIEN6001
white5168  的指教 ...
GBKEE 發表於 2012-8-4 15:19

說指教是不敢當,相互討論學習

作者: white5168 時間: 2012-8-4 16:18

回復 white5168

扼脕!又斷了
我的3.5G這麼不穩!

其實W大的,我一直都不能正常使用
末學還有很多看 ...
HSIEN6001 發表於 2012-8-4 14:51

看code不要只看一半,請注意Sheet1(股票代碼) FilePath = "D:\Test\" 的路徑,看看你自己的電腦是否有D槽的存在,如果沒有請自行修改

作者: white5168 時間: 2012-8-4 16:20

回復 white5168

G大這裡指令很完整,應該不是頁數回覆問題 (我也測試過這個頁面回覆)
Do Whil ...
HSIEN6001 發表於 2012-8-4 15:01

又只看一半的code
      Do While .Busy Or .readyState <> IE_READYSTATE.READYSTATE_COMPLETE
         DoEvents
      Loop

      Do
         DoEvents
      Loop Until .document.readyState = "complete"
以上的程式碼要跑完,網頁才算是開完全

作者: white5168 時間: 2012-8-4 16:28

回復  white5168    謝謝你的提醒指教
回復  c_c_lai          回復  HSIEN6001
white5168  的指教 ...
GBKEE 發表於 2012-8-4 15:19

Sub 取得交易明細總頁數()
Dim myTime
Dim Retry As Integer
Set IE = CreateObject("InternetExplorer.Application")
strLink = "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
Retry = 0
Do
Do
Do
Do
Do
網頁開啟完成與否
On Error Resume Next
Set doc = IE.document
On Error GoTo 0
Loop While doc Is Nothing
Set element = doc.getElementsByName("txtTASKNO")
Loop While element.Length = 0
element.Item(0).Value = stockid
Set element = doc.getElementsByName("btnOK")
Loop While element.Length = 0
element.Item(0).Click
Application.Wait Now + TimeValue("00:00:02")
Set element = doc.getElementsByName("sp_ListCount")
'Set element = doc.getElementsByTagName("span")
Loop While element.Length = 0
Pagecount = element.Item(0).innerText
Retry = Retry + 1
If Retry = 5 Then Exit Do
Loop While Pagecount = ""
Set doc = Nothing
Set element = Nothing
IE.Quit
Set IE = Nothing
End Sub

複製代碼

我在這一段code裡作的多重防範,因為未來各位抓資料的時候可能是在尖峰時段,就是大家一起抓資料,會導致遠端伺服器的服務資源大家搶,如果只單單一次性抓總頁數,一定會發生抓不道的時候,所以才要多做幾道手續
再者我也擔心,因為VBA 沒有try...cash的語法,所以除了多家擠到防護,再來就是記錄每一筆抓取的ID,當錯誤發生的時候才有機會可以再重斷點開始抓取,而不是重頭
在抓證交所資料時,時常會被證交所的防火牆強制斷出,需為這個部分多加幾道防護才行,因此這一點請各位務必多多注意

作者: GBKEE 時間: 2012-8-4 17:14

回復 22# white5168
說的好理道出: 下載錯誤點的原因
多謝發表幫大眾解惑

作者: HSIEN6001 時間: 2012-8-4 19:28

回復 20# white5168

O_p 好啦!我自首----->(PS:自首無罪!!Please)

這VBA學習,常遇到很多生字,一直查資料 + 吸收消化不良
常心生退念--->(發懶)
因為大師的編碼方式對我這初學者來說太深奧了!
就看了前面露露長就眼花撩亂---->不知從何查生字
跳過浪過,就自己搞笑囉!派謝捏!

對了!上市代號取得時,少了兩支;比對結果是
3638 　F-IML
3673 　F-TPK
當然還看不懂大師作品,不會自行除錯

頁數取得時,若改成postdata擷取原始碼的方式比較快?
看著ie刷了好幾次畫面都取不到頁數
反而在此多卡了些時間

目前先測試代號及頁面取得
其他....還沒消化
Sorry!貽笑大方

作者: white5168 時間: 2012-8-4 20:08

執行這個程式抓的資料量大，是否證交所會偵測而中斷下載呢?
funnydisk 發表於 2012-8-4 19:27

證交所其實有在偵測是否有人用程式在抓取資料,這一點可用python回到的結果更明顯清楚的看到,因為每當資料長時間讀取時,證交所的防火牆就會讓同一組IP強制斷開,好讓其他人可以使用,其實各位也可以清楚資料,怎嚜測試呢?就在每天各交易日的下午17:30開始就會有人開始抓取資料,尖峰時段8:30~13:30.再這段時間理,可以自行連結去查詢,就會發現網頁無法正常開啟,而且這樣的狀況會持續到23~23:30慢僈地恢復正常,不過有鑑佣常事抓資料大有人在,他們也在改變政策,目前有聽說將會在9月份多提供付費的CSV檔,大家可以期待

作者: white5168 時間: 2012-8-4 20:24

對VBA有興趣者但沒什呢基礎者可以參考http://forum.twbts.com/viewthread.php?tid=7356&extra=

作者: HSIEN6001 時間: 2012-8-4 21:25

回復 28# funnydisk

其實付費機制早就存在
http://dataeshop.twse.com.tw/frontend/cht/index.jsp

只是.....會寫程式抓資料的,如W大
那筆錢,當然會自己省起來囉!

作者: HSIEN6001 時間: 2012-8-4 21:37

回復 22# white5168

猴。。。。。突然意會過來，先前這樣測試
W大這支,光在這裡http://bsr.twse.com.tw/bshtm/bsMenu.aspx?
取不到頁數的時候,要刷個好幾次畫面 (網頁開啟完成與否?)

光是這樣刷的方式,賭死的機率更高
會造成塞車!!!!尖峰時段更會堵住

作者: white5168 時間: 2012-8-4 21:56

回復 white5168

猴。。。。。突然意會過來，先前這樣測試
W大這支,光在這裡http://bsr.twse.co ...
HSIEN6001 發表於 2012-8-4 21:37

請回第一頁我ㄧ開始PO文的內容,請仔細詳讀功能,文字說明的很清楚會Retry幾次?請再把code讀清楚

作者: HSIEN6001 時間: 2012-8-4 22:34

回復 30# white5168

沒錯呀!測試結果如同你寫的
當網頁開啟有問題時,及遠端證交所伺服器過忙碌時,將會進行Retry直到取得資料
你丟個沒有交易買賣的代號給它,就刷不停了
例如冷門的股票,它的交易量有可能是 " 0 "
就會出現無交易資料,當然就取不到  "頁數"
你說自己程式要刷幾次,你當然比我清楚

我測試時,光看它不斷同一個代號key in 代碼  --->就傻眼了
畫面不斷刷個好幾次,才會跳出回圈  (Do...Loop 也不少)
多刷N次,也代表卡在那裡

塞車原理就是  "我塞住,大家也塞住!"

試試改postdata好一點!
大師!!

作者: white5168 時間: 2012-8-4 22:55

回復 white5168

沒錯呀!測試結果如同你寫的
當網頁開啟有問題時,及遠端證交所伺服器過忙碌時,將 ...
HSIEN6001 發表於 2012-8-4 22:34

如果交易"0"頁的話,在長度上依然可以取得頁數,就是0頁,只有在不存在的股票代碼上才沒有物件的長度,如此才會不斷的Retry
基本上這是抓頁數,可以抓到的話一次就可以抓到,而會像你說的發生塞車的話,這比較像使用暴力法一頁一頁的抓交易明細才有機會發生
如果你覺得Retry次數太多,那就自行修改,我經過壓力測試也沒你說的issue我的作法是確保資料完完整整的抓下來,如果你堅持覺得有不妥
可自行選用版主的作法,我這樣樣Retry的作法暫時不會動,現在只會去做優化的動作,如果你真的有試到容易複製的issue,那也請完完整整的漿過程全部PO文上來
包含,做了什麼動作,流程,股票代碼,在什麼樣的環境,什麼樣的交易日的時間點等,以上這些都很重要

作者: HSIEN6001 時間: 2012-8-4 23:37

回復 32# white5168

不是喔!
版大先前有強調,VBA寫法,太慢--->大家堵在那之類的
會影響大家抓資料---->充分發揮了公德心

而我只是多看多學,增加自己對VBA的學習而已
剛好測試到抓頁數那部份,W大也是有設計上的盲點
剛好違背了你先前的理念

我只是提醒及建議!沒強迫你改
我並沒有依賴你寫的----->(學習者的心態)

W大的功力甚強
我當然是秉持學習的心態
只要有人願意分享;都是參考及學習
沒有一定誰好誰壞
別誤會!

作者: HSIEN6001 時間: 2012-8-4 23:40

回復 32# white5168

忘了附上你所謂的 (不存在股票)
測試過程
[attach]12021[/attach]

作者: white5168 時間: 2012-8-4 23:40

回復 white5168

不是喔!
版大先前有強調,VBA寫法,太慢--->大家堵在那之類的
會影響大家抓資料---->充 ...
HSIEN6001 發表於 2012-8-4 23:37

我並未違背我的理念,既然你都說有盲點,那你怎嚜無法將你遇到的狀況充分且具體的交待清楚呢?

作者: white5168 時間: 2012-8-4 23:53

小姐

我明明就有更新股票代碼的功能，程式中也明白是針對CFICode名為"ESVUFR"的 795檔股票來做交易明細下載（程式碼真的要看清楚，不要老是看一半）,我相信我的程式功能裡並沒有提到股票代碼可以自行變更吧?我只說能供股票編號ＩＤ與交易日期做變更，如果你有做權證的,那你可以自行在做修改，為了一個沒有做的功能來質疑別人，不是很奇怪嗎？你要問問題前，請問你是否有清楚瞭解程式的功能與真的能做到的範圍？
我相信我並未違背我的理念，只是你拿一未實現的功能來爭執討論，會不會太牛頭不對馬尾

作者: lalalada 時間: 2012-8-5 01:01

哇突然多好多討論
我個人處理這問題的方式是利用for...next 這樣可以指定次數
避免陷入長久的迴圈
同時寫另外一個小程式於事後針對資料為空的部分重新下載確認
另外有個問題是
我從證交所抓取的所有股票代碼
有些是沒有交易明細的
也就是股票存在卻無資料
僅供大家參考~

作者: GBKEE 時間: 2012-8-5 07:04

本帖最後由 GBKEE 於 2012-8-5 07:20 編輯

回復 31# HSIEN6001
丟個沒有交易買賣的代號給它,就刷不停了,例如冷門的股票,它的交易量有可能是 " 0 ",就會出現無交易資料,當然就取不到  "頁數"

執行 7#   Sub 查詢股票日報表() '查詢單一股票  立即可知有無交易量

7#  --- 57行  是處裡交易量是 " 0 "
54行 Private Sub 匯入日報表(股票代號 As String)    '處裡傳送來的 --股票代號--
55行 Dim Xall As Integer, SubMsg As String, SubRng As Range
56行 Xall = Val(報表頁數(股票代號))             '傳回報表頁數
57行 If Xall = 0 Then                                     '無報表頁數: 報表不存在
58行       If Rng Is Nothing Then
--------------------------------
18# 修正的 Private Function 報表頁數(Sstock_N0 As String) 函數程式碼
可處理 :  white5168 說的如果IE沒有開完整,將會導致無法取得對應的物件
當報表頁數 = element.Item(0).innertext  有錯誤時才會重新開啟 IE,
IE 正常時 element.Item(0).innertext="" 為無報表頁數   不嘿有錯誤產生

作者: HSIEN6001 時間: 2012-8-5 08:38

早呀!大家~^__^~

回復 36# white5168
目前該Excel VBA 交易明細.xls 為V1.0.0.1 T01
其功能如下
1.開啟時會自動將當天的日期設定,並將欲取得的上市股票ID編號重頭開始(這裡是2)
2.下載儲存交易明細日期與上市股票ID編號,可自行設定

重點：
1、其實我並沒有要逞口舌之快；苦口婆心的成分居多。　只希望Ｗ大能夠避免〔一言堂〕，聽不進別人的建言；卻老愛刮別人鬍子。　＊〔教學相長〕＜---還是那句，再次送你，雖然我最沒資格說這句。
2、各大高手都有自己的邏輯,程式迴路--->一山還有一山高。 <----自己外行,所以我該靜靜學習。(這點!我在這裡真的很 [多嘴] ,所以先跟各位看倌說對不起!)
3、版上不是競技場，我是來學習及尋求 [好心的大大們] 可以適時的拯救我。
4、我看見麻辣家族的用心經營；所以很感恩這個學習空間。
各位抓資料的時候可能是在尖峰時段,就是大家一起抓資料,會導致遠端伺服器的服務資源大家搶
ＰＳ：看的懂得，都應該懂你的Do ....Loop 會造成塞車問題。　我只是想＃２２樓你寫的那段；剛好與你的迴路設計是背離的！　----＞提醒而已！別生氣。

＊＊＊＊＊＊＊＊　真的別生氣，Please!!! 因為怕大大生氣，所以自己很小心翼翼的。　原諒我吧！－－－＞不然我會哭喔！＊＊＊＊＊＊＊＊

回復 37# lalalada
嗯嗯!你的建議及提點，收到囉！我會放進思考裡Try看看
我目前做法是下載回來，再用巨集判讀無資料的刪掉就好。---->避免過長時間掛載，增加危險性。（大略看過這樣的分析〕

回復 38# GBKEE
　GBKEE　大，有您真好！
感謝你們這些熱心且真正樂意協助的大大們！
時常協助我們解決困擾

跟版上各位大大們繼續學習，有勞你們了。

作者: white5168 時間: 2012-8-5 09:27

本帖最後由 white5168 於 2012-8-5 09:29 編輯

早呀!大家~^__^~

回復 white5168
目前該Excel VBA 交易明細.xls 為V1.0.0.1 T01
其功能如下
1.開啟 ...
HSIEN6001 發表於 2012-8-5 08:38

我並非聽不進別人的諫言,但自己是否有聽進別人說(一個不存在的流程經你的實驗後所產生問題),而你打從一開始就在拿一個不存在的功能來爭執,你說的0050之類的股票再我這裡的作法的確是無法動作,但你又曾幾何時仔細認真讀過code能做到的功能,去了解為什麼會造成Dead Loop(你自己強調要學code,不願花功夫去了解),我強調明明打從一開始就說的很清楚是股票代碼ID可以自行變更,沒說股票代碼可以變更,如果真是股票代碼我又何必加上ID字眼去強調它的不同呢?況且我功能的第5點也說明了股票代號與股票ID的不同用法,清楚的也交代了,"當Retry 5次無法下載市股票ID的總頁數網頁時,會記錄該日期與股票以供參考",紛明就是你認知上的不同與理解不清,為何不一開始就問兩者的差異呢?
我是有說可以提供問題,但不是叫你拿一個不存在的流程經你的實驗後所產生問題來我質疑我來跟我吵,這樣不是在反映問題,如果你認為要提出諫言過程是要以爭執才是你表達意見的方式,那我只能說你的表達方式真的很.........另類
請問你的表達難道無法以"你發現了在什麼流程下,經什麼實驗流程後,會產生什麼的數據結果"這樣的說法也比較不像是在爭執,我也會很有意願的來跟你討論修改,而非像你現在這樣吵,覺得是自己在"股票代碼"與"股票代碼ID"的認知不同而不法下台
還有想請問如果你認為我的不好用為何一直拿來做文章呢？這不是很矛盾？

作者: GBKEE 時間: 2012-8-5 09:30

本帖最後由 GBKEE 於 2012-8-5 09:39 編輯

敬告各位會員
希望各位在回文時字句的修飾是必須的,要考慮到對方有不舒服的感受,請不要製造出互相攻擊的氛圍
在這論壇上我真的是有感受到〔教學相長〕效應的存在
回復 39# HSIEN6001
1# 附檔有說明 :  "現在附上使用python與Excel VBA執行完成的圖案,python執行的時間2603秒,Excel VBA執行時間7598秒(未優化前),兩者相差約2.9倍"
上述的差異 39#中一段:  "Do ....Loop 會造成塞車問題。　我只是想＃２２樓你寫的那段；剛好與你的迴路設計是背離的" 這裡道出產生"速率的差異"

所以我 7#  的程式修正不必要的迴圈,  消除2.9倍的速率,但還是有缺點  經 white5168 指點  在18# 修改了  在這裡我就有收到〔教學相長〕效應
你可再測試 7#  的程式看看  python執行的時間2603秒,Excel VBA執行時間7598秒還有2.9倍的速率的差異嗎? ,
可說明塞車問題是否是正確的

PS: 7#的程式碼已更新同 18#

作者: white5168 時間: 2012-8-5 09:36

敬告各位會員
希望各位在回文時字句的修飾是必須的,要考慮到對方有不舒服的感受,請不要製造出互相攻擊的 ...
GBKEE 發表於 2012-8-5 09:30

7598秒為未優化前的數據,開啟視窗的執行迴圈是不開視窗執行迴圈的3.5倍,版主該不會也在文字上沒注意看到吧?

作者: GBKEE 時間: 2012-8-5 09:50

本帖最後由 GBKEE 於 2012-8-5 09:54 編輯

回復 42# white5168
你這未優化與我 7# 未更新前的程式一樣尚未測試確定沒問題就急著推出有點類似
期待你優化後 VBA 會 [ 教學相長 ] 的
想請教 python 也是未優化嗎?

作者: HSIEN6001 時間: 2012-8-5 10:22

回復 41# GBKEE

'取得頁數 ; 避開只為 [頁數] 取得而拼命刷該網頁;造成塞龜 http://bsr.twse.com.tw/bshtm/bsMenu.aspx?
strURL = "http://bsr.twse.com.tw/bshtm/bsMenu.aspx?" & _
"__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE=%2FwEPDwUKMTczNDk4NzY0Mg9kFgICAQ9kFgwCBQ8WAh4JaW5uZXJodG1sBQoyMDEyLzA4LzAxZAIGDxYCHwAFCDIwMTIwODAxZAIIDw8WBh4JRm9udF9Cb2xkZx4EXyFTQgKEEB4JRm9yZUNvbG9yCj1kZAIKD2QWAgIBDw9kFgIeB09uQ2xpY2sFHGphdmFzY3JpcHQ6YnV0Q2xlYXJfQ2xpY2soKTtkAgwPDxYGHwFoHwIChBAfAwpHZGQCDg8PFgIeB1Zpc2libGVoZGRktxLZGMAybpsQ2UGpZGNtbwAAAAA%3D&__EVENTVALIDATION=%2FwEWCALzjPG5CALjpuXcAwKN4Ij0CwLB5ZfoCQLjk6TKBwKY8en5CwLdkpmPAQL6n7vzC9kuc7umJfLwqKqibgdx3poAAAAA&HiddenField_spDate=&HiddenField_page=PAGE_BS&txtTASKNO=" & fileIdx & "&hidTASKNO=&btnOK=%E6%9F%A5%E8%A9%A2"
With xml
.Open "GET", strURL, 0
.send
Do While xml.readyState <> 4
Loop
x = Split(Split(.responseText, "sp_ListCount"">")(1), "</span></b>")(0)
End With
'將頁數丟給下載去處理
'下載xls
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & fileIdx & "&FocusIndex=All_" & x _
, Destination:=Range("A1")) '放置位置< ----->可變
.Name = "券商"
.BackgroundQuery = True '刷新返回查詢(執行更新)
.RefreshStyle = xlOverwriteCells '= xlOverwriteCells '覆蓋原欄位 = xlInsertDeleteCells '插入新資料,原資料右移
.RefreshPeriod = 0 '自動更新時間以分為單位 5代表每5分鐘更新一次 0代表不自動更新
.WebSelectionType = xlSpecifiedTables '指定類型= xlEntirePage 整頁 = xlSpecifiedTables 表格 = xlAllTables 所有表格
.WebFormatting = xlWebFormattingNone '= xlWebFormattingNone 不保留連結及樣式 = xlWebFormattingRTF 保留連結及格式設定
.WebTables = "5,""table2""" '指定取得之表格與 .WebSelectionType = xlSpecifiedTables配合 = "1,2," 或 ="5,""table2""" 或 = """table1"",""table2"""
.WebDisableDateRecognition = False '日期鑑別=False 禁用 =True 使用
.Refresh BackgroundQuery:=False '刷新返回查詢(執行更新)
End With

複製代碼

我是真的佩服W大的功力,完全沒有攻訐意思。
我很菜,看過我先前的發問就知道我是菜鳥一個；時常勞煩各位幫忙解決〔很感恩〕。
只是[提醒]刷頁面問題，也是另一個塞車的困擾。 [這勉強可算 (教學相長) 的一部份]
至於寫；因為還再不斷 Try 於VBA 很陌生的生字。沒到可以獻醜的部份。

現在正在思考的問題是 , 因為處理xls存檔；也掛載相當久。所以改用htm下回來再一起處理。
相關學習思路也是在版上，有跡可循。

http://forum.twbts.com/thread-7336-1-1.html
http://forum.twbts.com/viewthrea ... p;extra=&page=2

寫程式沒有絕對的誰好誰不好
可以再不同的思路中；學到更多的可能性
這點真的很棒！ --->相信很多版大都有這種初衷
所以樂意在此幫助像我這樣的菜鳥

我目前還沒見過因為自己寫的爛
攻擊我的,都是適度給我其他更多的參考
這對於吸收不同的思維
提供了很好的輔助
不是嗎?!

在此!慎重聲明~~~不再回應W大的程式測試結果或提出問題
因為,我也怕受傷呀!

~~~正在哭!~~~

作者: white5168 時間: 2012-8-5 11:45

回復 GBKEE 我是真的佩服W大的功力,完全沒有攻訐意思。
我很菜,看過我先前的發問就知道我是菜鳥一個；時常 ...
HSIEN6001 發表於 2012-8-5 10:22

我笑了
拿一個未被實現的功能來評論別人,完之後就趕快跑,這樣卻說自己很受傷,打人喊救人,如果每個人都這樣那真的沒完沒了
還有你所貼出的code跟我的應該是不同,你該不會是拿自己寫的code,跑出問題再來質疑別人吧

作者: Hsieh 時間: 2012-8-7 11:36

本篇主題討論至今，大家踴躍討論，中間或許也有些口舌辯論
希望盡量以針對程式技術做討論，不必要的口水戰請適可而止
整體過程中已經有了完整的結論，當然要各憑本事去體會
這類下載方式，其實對於網管人員來說，是非常不認同的
所以下載不完全並非程式的問題(不論您使用任何程式下載結果是一樣的)
就VBA技術來說，本帖已經完全得到結論，為避免再有不愉快的口水戰
本帖將關閉討論。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)