stock_sample_v1.3.xlsm
https://drive.google.com/open?id=1g5saowjYAeXNi73a0pss96-xZeXPUTXr
使用方式:
1. 「關注」的分頁C列填入股票代碼。
2. 點擊「關注」分頁左上「refresh」按鈕就可以刷新全部。
(判斷方式是16:00以前只刷新興櫃,16:00以後則全部更新。如果想假日更新最新的前一交易日,可以改TWN分頁的A10~A12)
調整內容:
1. 新增更新全部分頁的方式
2. 修正了櫃買中心的興櫃csv連結為:http://www.gretai.org.tw/storage/emgstk/ch/new.csv
目前問題:
1. 興櫃股票我抓的政府資料開放平臺的資料沒有前一天價格,所以沒有辦法算漲跌、漲跌幅和昨收。(如果有人知道哪邊抓的資料有漲跌或前一天價格可以跟我說一下)
2. P/E只有上市有。
3. 美股不知道哪邊有資料,有人知道那邊有美股類似證交所這樣一個表有全部股價資料的網站嗎?
新增的巨集內容如下。
Private Sub CommandButton1_Click() Sheets("TWN").Select '宣告變數 Dim QuerySheet As Worksheet Dim DataSheet As Worksheet Dim qurl As String Dim NOW, BN, LTH As Long NOW = Sheets("TWN").Range("A4") BN = Sheets("TWN").Range("A9") LTH = Sheets("TWN").Range("A8") '告訴Excel不要每更新一格就重新計算 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '將現在的工作表設為資料表 Set DataSheet = ActiveSheet qurl = "http://www.gretai.org.tw/storage/emgstk/ch/new.csv" '選擇TWN sheet Sheets("TWN").Range("B:Z").Clear If NOW >= BN Then If LTH < 16 Then '如果時間是16:00之前 '抓取資料(TWN sheet) QueryQuote: With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True .RefreshStyle = xlInsertEntireRows .Delete End With '讓Excel重新活回來,讓資料能夠顯示 Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '切數據(TWN sheet) Sheets("TWN").Columns("B:B").Select Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ TrailingMinusNumbers:=True '否則(如果時間是16:00之後) Else '抓取資料(TWN sheet) QueryQuote2: With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True .RefreshStyle = xlInsertEntireRows .Delete End With '讓Excel重新活回來,讓資料能夠顯示 Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '切數據(TWN sheet) Sheets("TWN").Columns("B:B").Select Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ TrailingMinusNumbers:=True '更新上一交易日(TWN sheet的BN變數) Sheets("TWN").Range("A4:A7").Select Selection.Copy Sheets("TWN").Range("A9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選擇TWO sheet Sheets("TWO").Select '告訴Excel不要每更新一格就重新計算 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '將現在的工作表設為資料表 qurl = "http://www.tpex.org.tw/web/stock/aftertrading/otc_quotes_no1430/stk_wn1430_print.php?l=zh-tw&d=" + Sheets("TWO").Range("A9") + "/" + Sheets("TWO").Range("A10") + "/" + Sheets("TWO").Range("A11") + "&se=EW&s=0,asc,0" Sheets("TWO").Range("B:Z").Clear '抓取資料(TWO) QueryQuote3: With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("TWO").Range("B1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True .RefreshStyle = xlInsertEntireRows .Delete End With '讓Excel重新活回來,讓資料能夠顯示 Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '選擇TW sheet Sheets("TW").Select '將現在的工作表設為資料表 Set DataSheet = ActiveSheet qurl = "http://www.tse.com.tw/exchangeReport/MI_INDEX?response=csv&date=" + Sheets("TW").Range("A9") + Sheets("TW").Range("A10") + Sheets("TW").Range("A11") + "&type=ALLBUT0999" Sheets("TW").Range("B:Z").Clear '抓取資料(TW sheet) QueryQuote4: With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True .RefreshStyle = xlInsertEntireRows .Delete End With '讓Excel重新活回來,讓資料能夠顯示 Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '切數據(TW sheet) Sheets("TW").Columns("B:B").Select Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ TrailingMinusNumbers:=True End If End If '選擇關注 sheet Sheets("關注").Select End Sub
紀錄:
office 2010 64bit、2016 64bit可使用
感謝 無私的奉獻
回覆刪除感謝分享如此強大的功能 :)
回覆刪除謝謝版主的分享,感恩
回覆刪除版主~抓TW SHEET的資料好像有錯誤
回覆刪除謝謝版大分享 超棒實用工具的
回覆刪除謝謝版大的分享!!!
回覆刪除謝謝分享,不過居然沒有006201
回覆刪除查到了,在TWO 6201
刪除好強大,感謝版主大大
回覆刪除作者已經移除這則留言。
回覆刪除感謝無私分享 但我填入2603這隻 數字確不是最新的是否我哪裡弄錯了,可否告知謝謝
回覆刪除您好~~不好意思請教一下 Excel 「關注」分頁左上「refresh」按鈕變成 image1.png 無法更新。請問一下該怎解決這問題呢? 感謝你的提供萬分感謝
回覆刪除版主 想請問一下 "csv連結為:http://www.gretai.org.tw/storage/emgstk/ch/new.csv" 你是怎麼找出來, 我點選檢查網頁, 都找不到csv連結, 可以麻煩做個教學 謝謝
回覆刪除您好 不好意思 請問是不是無法使用了?
回覆刪除