12345
返回列表 上一主題 發帖

[發問] 網頁資料下載簡化

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
29# 跳轉到 »
發表於 2012-7-5 15:47 | 只看該作者
回復 31# gracyei
修改如下
  1. Option Explicit
  2. Sub 個股交易整頁()
  3.     Dim 股票代號 As Range, 日期 As Variant, F As Range
  4.     Do While Not IsDate(日期)
  5.         日期 = InputBox("輸入查詢日期", "日期", Date)
  6.         If 日期 = "" Then End
  7.     Loop
  8.     日期 = Format(日期, "yyyymmdd")
  9.     Set 股票代號 = ThisWorkbook.Sheets("代號").[A1]
  10.     On Error Resume Next                           '不理會 在執行程式的時候發生的錯誤
  11.     Do While 股票代號.Value <> ""
  12.         ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
  13.         ActiveSheet.Name = 日期 & "-" & 股票代號
  14.         Sheets("代號").Activate
  15.         With Sheets(日期 & "-" & 股票代號)
  16.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=All_100", Destination:=.Cells(1))
  17.                 .Name = 日期 & "-" & 股票代號
  18.                 .WebSelectionType = xlEntirePage
  19.                 .WebFormatting = xlWebFormattingNone
  20.                 .WebPreFormattedTextToColumns = True
  21.                 .WebConsecutiveDelimitersAsOne = True
  22.                 .WebSingleBlockTextImport = False
  23.                 .WebDisableDateRecognition = False
  24.                 .WebDisableRedirections = False
  25.                 Do
  26.                     DoEvents
  27.                     Err.Clear                         'Err物件的重設
  28.                     .Refresh BackgroundQuery:=False   '查詢失敗 會產生錯誤
  29.                 Loop Until Err.Number = 0             '執行迴圈直到錯誤消:失 查詢成功
  30.             End With
  31.             .Range("F5:H" & Rows.Count).Delete 1
  32.             .Range(.Cells(.Rows.Count, "B").End(xlUp).Offset(1), .Cells(.Rows.Count, "B")).Offset(, -1).Clear
  33.             .Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
  34.             Set F = .[A:A].Find("*頁 / 共*", LOOKAT:=xlPart)
  35.             Do While Not F Is Nothing
  36.                 F.Offset(-1).Resize(7).EntireRow.Delete
  37.                 Set F = .[A:A].FindNext
  38.             Loop
  39.             .UsedRange.Columns.AutoFit
  40.         End With
  41.         Set 股票代號 = 股票代號.Offset(1)
  42.     Loop
  43.     MsgBox "下載完畢 !!!", 32 + 0, "個股交易明細"
  44. End Sub
複製代碼

TOP

gracyei

帖子
12 
主題
2 
精華
0 
積分
14 
點名
0  
作業系統
Window7 
軟體版本
Office2003 
閱讀權限
10 
註冊時間
2012-6-26 
最後登錄
2023-8-18 

論壇贊助勳章
28#
發表於 2012-7-4 17:48 | 只看該作者
回復  gracyei
將檔案上傳看看
GBKEE 發表於 2012-7-4 16:13

測試檔是從本帖16樓下載,無做修改,麻煩GBKEE大大看一下
測試.rar (17.46 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
27#
發表於 2012-7-4 16:13 | 只看該作者
回復 29# gracyei
將檔案上傳看看

TOP

gracyei

帖子
12 
主題
2 
精華
0 
積分
14 
點名
0  
作業系統
Window7 
軟體版本
Office2003 
閱讀權限
10 
註冊時間
2012-6-26 
最後登錄
2023-8-18 

論壇贊助勳章
26#
發表於 2012-7-4 00:02 | 只看該作者
回復 28# GBKEE


    感謝GBKEE大大的回覆,小弟下載#16的測試檔做測試每次跑到第2檔1102時就會發生錯誤,且第2檔股票Sheet的內容會被這一段指令Clear掉,且代號的Sheet會被刪除掉;若只設定1檔則可完成,小弟還是找不出哪裡的問題,請問大大是哪裡的問題?? THX!!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
25#
發表於 2012-7-3 13:46 | 只看該作者
回復 27# gracyei
Sheets(日期 & "-" & 股票代號).Cells.Clear   

"執行階段錯誤'424':此處需要物件   活頁簿中沒有命名為日期 & "-" & 股票代號 的工作表

日期 & "-" & 股票代號  這工作表所有Cells(儲存格).Clear(清除資料)

TOP

gracyei

帖子
12 
主題
2 
精華
0 
積分
14 
點名
0  
作業系統
Window7 
軟體版本
Office2003 
閱讀權限
10 
註冊時間
2012-6-26 
最後登錄
2023-8-18 

論壇贊助勳章
24#
發表於 2012-7-2 23:12 | 只看該作者
回復  carzyindex
有此網頁好辦些,但下載還是很費時的,慢慢的測試吧!!
GBKEE 發表於 2011-5-17 16:04


GBKEE大大,下載測試檔測試時第一支個股下載完畢後,會出現 "執行階段錯誤'424':此處需要物件" ,偵錯後會指向這一段程式" Sheets(日期 & "-" & 股票代號).Cells.Clear ",小弟還是初學者,想請問大大這一段代表什麼意思??請大大賜教

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
23#
發表於 2012-5-31 00:09 | 只看該作者
本帖最後由 white5168 於 2012-5-31 00:23 編輯

最近在5/30,5/29,5/28抓資料真的越來越有難度了,搞不懂到底哪個害群之馬一直在操掛 證交所的伺服器,搞的大家要抓資料都變的很困難
我是用python來下載資料就已經快抓狂了,我看用VBA抓資料的人應該會更想打人,因為 證交所的防火牆已經做了修改,因為在尖峰時段防火牆會限制連線數與時間,要長時間連線抓資料真的會有難度
用python下載上市795支股票的資訊,在這3天要花2~3小時,是平實抓上市795 上櫃615 (我抓的不是單一支股票的時間是全部)時間的3倍,真的大家找找這個害群之馬
最近也在用VBA抓網頁,但不是抓每日成交明細,不然我也會受不了
祝大家好運

TOP

lasum

帖子
8 
主題
0 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
Office 2002 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2019-2-21 
22#
發表於 2012-5-30 14:47 | 只看該作者
目前正在學 股票資料下載…
感謝GBKEE大…提供的程式…
目前測試正常…共下載23頁…
走急的人看不見地上的釘子， 煩惱的人享受不到幸福的日子。

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
21#
發表於 2012-2-9 11:19 | 只看該作者
謝謝GBKEE所做的範例。

TOP

ginbow

帖子
28 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
windows xp pro 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2010-5-5 
最後登錄
2016-6-8 
20#
發表於 2011-7-24 00:54 | 只看該作者
如果要做籌碼分析 證交所因該有提供三大法人個股每天買賣超資料
http://www.twse.com.tw/ch/trading/fund/TWT43U/TWT43U.php
提供給你參考 資料下載這部分 真的很困難...因為他有些以脫離VBA
有些網頁不是那麼有善 所以要會些html的語法
不過你也可以試著用 ctrl c + ctrl v 方式 把整個網頁複製到excel 在去抓你要的

^^ 祝你好運囉
GinBow

TOP

        靜思自在 : 要用心，不要操心、煩心。
12345
返回列表 上一主題