用Excel抓Yahoo Finance歷史股價 - 股票

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

------以下是內文------
google試算表跑資料很慢，而且抓不到上櫃和興櫃資料。

而且如果要跟我原本電腦裡的資料連結還要下載下來。

因為有用Excel做紀錄的習慣，所以還是直接匯在Excel的檔案裏面比較方便。


研究了幾天，把之前yahoo那個VBA，改成抓證交所、櫃買中心、政府資料開放平臺的方案
，供大家參考：
https://drive.google.com/open?id=1Ekn1MIGolNi3bqoH-xfv16mD9Z_D0OoF

（政府開放平台的興櫃資料我是查到這個：https://data.gov.tw/dataset/11398
因為我不知道怎麼解析櫃買中心的興櫃csv下載連結，有人知道的話可以跟我說下）

使用方式：
1. 「關注」的分頁C列填入股票代碼。
2. 點擊「TW」、「TWO」、「TWN」各分頁左上「refresh」按鈕就可以刷新。

目前問題：
1. 興櫃股票我抓的政府資料開放平臺的資料沒有前一天價格，所以沒有辦法算漲跌、漲
跌幅和昨收。（如果有人知道哪邊抓的資料有漲跌或前一天價格可以跟我說一下）
2. P/E只有上市有。
3. 目前我只會每個分頁各自加一個按鈕，但我不知道怎麼樣做可以一個按鈕直接刷新三
個分頁，如果有人知道怎麼做可以教我一下，我可以調整一下。
4. 美股不知道哪邊有資料，有人知道那邊有美股類似證交所這樣一個表有全部股價資料
的網站嗎？
5. 我不知道要怎麼判斷最近交易日，所以如果還沒收盤或假日用會沒資料。
（暫時先找了一個土炮的方法，目前的連結已經先更新）


巨集內容如下。

抓上市股票：

Private Sub CommandButton1_Click()

'宣告變數
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
'告訴Excel不要每更新一格就重新計算
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
Set DataSheet = ActiveSheet
qurl =
"http://www.tse.com.tw/exchangeReport/MI_INDEX?response=csv&date=" +
Range("A9") + Range("A10") + Range("A11") + "&type=ALLBUT0999"
Range("B:Z").Clear
'抓取資料
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
'切數據
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 Sub

抓上櫃股票：
Private Sub CommandButton1_Click()

'宣告變數
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
'告訴Excel不要每更新一格就重新計算
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
Set DataSheet = ActiveSheet
qurl =
"http://www.tpex.org.tw/web/stock/aftertrading/otc_quotes_no1430/stk_wn1430_print.php?l=zh-tw&d="
+ Range("A9") + "/" + Range("A10") + "/" + Range("A11") +
"&se=EW&s=0,asc,0"
Range("B:Z").Clear
'抓取資料
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
End Sub

抓興櫃股票：
Private Sub CommandButton1_Click()
'宣告變數
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
'告訴Excel不要每更新一格就重新計算
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
Set DataSheet = ActiveSheet
qurl = "http://www.gretai.org.tw/storage/emgstk/ch/new.csv"
Range("B:Z").Clear
'抓取資料
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
'切數據
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 Sub



--