12345
返回列表 上一主題 發帖

新版股市公開資訊觀測站的資料抓到EXECL?

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
41# 跳轉到 »
發表於 2015-11-17 07:02 | 只看該作者
回復 40# chang0833
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Wb As Workbook
  4.     Set Wb = ActiveWorkbook                         '作用中活頁簿
  5.     Set Wb = ThisWorkbook                           '程式碼所在的活頁簿
  6.     Set Wb = Workbooks("book1")                     '已開啟了的活頁簿中,指定的活頁簿
  7.     Set Wb = Workbooks.Open("D:\試算表\Book1.xls")  '要開啟的活頁簿
  8.    
  9.     Set Wb = Workbooks("Book1.xls")                 '已開啟了的活頁簿中,指定的活頁簿
  10.    
  11. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

chang0833

帖子
23 
主題
1 
精華
0 
積分
58 
點名
0  
作業系統
windows 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2014-2-26 
最後登錄
2018-8-23 
42#
發表於 2015-11-17 23:48 | 只看該作者
感謝版大的教學，這部分我懂了^^
另外，再請教版大一些問題，希望版大不要覺得煩，有點良心過意不去~~
1.版大程式中有一個工作頁如果出現同名的解決方式，
可以把它換成同名就覆蓋原工作頁嗎？(只留下最後更新的資料)
2.執行程式時，工作頁會隨著每執行一次就一直增加，該如何清除？
3.在程式中，會把最新一年的四季下載完後，會往下面的"列"表在執行第二
  二年的下載，資料會在下面的"列"存放，可以都把它們全放在第一列嗎？
4.因為改第3項問題時，季別會照(105)1.2.3.4.(104年)1.2.3.4季別存放，可以
從第一欄開始就直接放最新的季別嗎(例：像現在是第3季，就以第3季放在開頭
麻煩版大解惑了，謝謝^^

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
43#
發表於 2015-11-18 08:04 | 只看該作者
回復 42# chang0833
是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim URL As String, xCo_Id As String
  4.     Dim xSyear As Integer, xSseason As Integer
  5.     Dim Sh(1 To 2) As Worksheet, Rng As Range
  6.    
  7.     xCo_Id = Application.InputBox("請輸入股票代號", , 2303)         '預設為 2303
  8.     xSyear = Format(Date, "E")                 '中華民國的年度
  9.     xSseason = DatePart("q", Date)             '當季
  10.     Application.ScreenUpdating = False
  11.     'Set Wb = ThisWorkbook           '指定活頁簿
  12.     With ThisWorkbook           '指定活頁簿
  13.         Set Sh(1) = .Sheets.Add               '新增工作表: 複製季財報到指定工作頁
  14.         Set Sh(2) = .Sheets.Add               '新增工作表:  WEB查詢用
  15.     End With
  16.     On Error GoTo Er                        '處理程式上的錯誤
  17.     Application.DisplayAlerts = False
  18.     Sh(1).Name = xCo_Id & "季報表"          '這名稱工作表如已存在程式會有錯誤
  19.     Set Rng = Sh(1).[A1]
  20.     On Error GoTo 0                         '不再處理程式上的錯誤
  21.    
  22.     Do
  23.             URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
  24.             With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
  25.                 .Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
  26.                 .AdjustColumnWidth = True                  '自動調整欄寬
  27.                 .WebSelectionType = xlSpecifiedTables
  28.                 .WebFormatting = xlWebFormattingNone
  29.                 .WebTables = "2,3,4"                  '資產負債表,綜合損益表,現金流量表
  30.                 .WebPreFormattedTextToColumns = True
  31.                 .WebConsecutiveDelimitersAsOne = True
  32.                 .WebSingleBlockTextImport = False
  33.                 .WebDisableDateRecognition = False
  34.                 .WebDisableRedirections = False
  35.                 .Refresh BackgroundQuery:=False
  36.                 If .ResultRange.Rows.Count > 2 Then '有資料
  37.                     Debug.Print xSyear, xSseason, Rng.Address
  38.                     .ResultRange.Copy Rng
  39.                      Set Rng = Rng.Offset(, .ResultRange.Columns.Count + 1)
  40.                 Else
  41.                     .Delete
  42.                 End If
  43.             End With
  44.             xSseason = xSseason - 1
  45.             If xSseason = 0 Then
  46.                 xSseason = 4
  47.                 xSyear = xSyear - 1
  48.             End If
  49.     Loop Until xSyear = Format(Date, "E") - 3
  50.    
  51.     Sh(2).Delete
  52.     Application.DisplayAlerts = True
  53.     Application.ScreenUpdating = True
  54. '   Sh(1).Parent.Save
  55.     MsgBox "Ok"
  56.     Exit Sub
  57. Er:     '處理 xCo_Id &季報表 工作表已存在
  58.     Sheets(xCo_Id & "季報表").Delete '覆蓋原工作頁嗎？(只留下最後更新的資料)
  59.    
  60.     Resume     '回到錯誤的程式碼
  61. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

chang0833

帖子
23 
主題
1 
精華
0 
積分
58 
點名
0  
作業系統
windows 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2014-2-26 
最後登錄
2018-8-23 
44#
發表於 2015-11-18 22:58 | 只看該作者
回復 43# GBKEE


    太感謝版大了^^
就是這樣，其中我想以著程式做一些小修改(自己努力看看)，如果改不出來，再麻煩版大指導了，感恩^^

TOP

yarchen

帖子
2 
主題
0 
精華
0 
積分
2 
點名
0  
作業系統
Win 7 
軟體版本
0ffice 2013 
閱讀權限
10 
性別
男 
來自
台灣 台北 信義區 
註冊時間
2014-5-12 
最後登錄
2020-1-3 
45#
發表於 2016-6-6 00:02 | 只看該作者
感謝版大您的分享, 我已用 VBA 寫程式抓取 公開資訊觀測站 許多資料 存入 ACCESS DB 然後再做分析處理, 也是這方面有些經驗的 愛好者, 包含處理 SEND GET, POST 和 Request COOKIES 等等 ,
有一問題冒昧請教, 公開資訊觀測站 單位時間內 有訪問次數限制(好像是每分鐘限制連續訪問網頁20次左右), 在大量抓取 網頁資料時, 常有99%時間都在延遲等待, 我曾經想用 更改 ip, 或是多線程 平行處理來解決這個問題,  請教您是如何解決此一問題?? 感謝指點
.

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
46#
發表於 2016-6-6 08:13 | 只看該作者
回復 45# yarchen

會檔就調慢一點，一分鐘十次也行

不然改用vba xmlhttp post 方法抓

下面這個連結，學會後自己就會修改

http://club.excelhome.net/thread-1159783-1-1.html

TOP

jasonwu0114

帖子
28 
主題
7 
精華
0 
積分
43 
點名
0  
作業系統
windows7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2013-11-8 
最後登錄
2020-4-9 

論壇贊助勳章
47#
發表於 2016-12-23 17:03 | 只看該作者
回復 8# GBKEE


    請教G大
如果我在EXCEL表中列出一列20-30個股票代號
要查105第三季
""資產負債表""中的某一科目"ex  應付短期票券合計"的餘額放在股票代號旁邊

如何利用這隻程式來改??
小人物

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
48#
發表於 2016-12-24 08:29 | 只看該作者
本帖最後由 GBKEE 於 2016-12-24 09:07 編輯

回復 47# jasonwu0114
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim URL As String, xCo_Id As Range, xSyear As String, xSseason As String, i As Integer, M As Variant
  4.     xSyear = 105
  5.     xSseason = 3
  6.     For i = 1 To 20  '跑20-30個股票代號
  7.         Set xCo_Id = Sheets(1).Cells(i, "A")  '股票代號
  8.         URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
  9.         With SheetS(2).QueryTables.Add(Connection:=URL, Destination:=Sheets(2).Range("A1"))
  10.             .AdjustColumnWidth = False                   '自動調整欄寬
  11.             .WebSelectionType = xlSpecifiedTables
  12.             .WebFormatting = xlWebFormattingNone
  13.             .WebTables = "2"   ',3,4"                 '資產負債表,綜合損益表,現金流量表
  14.             .WebPreFormattedTextToColumns = True
  15.             .WebConsecutiveDelimitersAsOne = True
  16.             .WebSingleBlockTextImport = False
  17.             .WebDisableDateRecognition = False
  18.             .WebDisableRedirections = False
  19.             .Refresh BackgroundQuery:=False
  20.             With .ResultRange  '所匯入資料的範圍
  21.                 M = Application.Match("*應付短期票券合計", .Columns(1), 0)  '工作表函數在第一欄中傳回比對到的欄位
  22.                 If IsNumeric(M) Then xCo_Id.Offset(, 1) = .Cells(M, "b")             '有比對到傳回的欄位的數字
  23.                 .Clear
  24.             End With
  25.             .Parent.Names(.Name).Delete          '刪除工作表的名稱
  26.             .Delete                                             ''這QueryTable刪除掉
  27.         End With
  28.     Next
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jasonwu0114

帖子
28 
主題
7 
精華
0 
積分
43 
點名
0  
作業系統
windows7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2013-11-8 
最後登錄
2020-4-9 

論壇贊助勳章
49#
發表於 2016-12-26 14:49 | 只看該作者
回復 48# GBKEE


  OK太棒了
G大 感恩
終於解決困擾我長久以來的問題
又學到好幾招
小人物

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
12345
返回列表 上一主題