抓股票公開資料 Excel v1.3 - 股票

網誌好讀版：
http://kslman.blogspot.tw/2017/11/excalvbav13.html



--
插入股票公開資料的檔案我做了更新，供大家參考：
stock_sample_v1.3.xlsm
https://drive.google.com/open?id=1g5saowjYAeXNi73a0pss96-xZeXPUTXr

使用方式：
1. 「關注」的分頁C列填入股票代碼。
2. 點擊「關注」分頁左上「refresh」按鈕就可以刷新全部。
（判斷方式是16:00以前只刷新興櫃，16:00以後則全部更新。如果想假日更新最新的前一
交易日，可以改TWN分頁的A10~A12）
2017/12/1補充：我觀察交易日14:00上市上櫃也都有資料了，有需要可以自己改成14:00



調整內容：
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

--