擷取歷史股價

white5168

簡單擷取股價,讓使用者可以輸入自己所要的股票代碼後自動下載從2000/1/1到目前各股每天的歷史股價

chen_cook

這個get web的vba有設定限制,只能抓取固定的時間區段!!!

white5168

The tool supports 2000/1/1~current date
每支股票的上市上櫃日期不一定,所以可能顯示的長短不一樣,請自行確認各股票開始上市上櫃日期

freeffly

有看過人家用類似的方式抓資料
然後直接存檔

diabo

回復 1# white5168

Yahoo Finance 的股價資料，記得鴻海(2317)集團的會有問題....

peter460191

回復 1# white5168


    您這個程式非常不錯,方便分享如何抓取嗎?

jsleee

回復 1# white5168


    感謝大大的分享....
    不知道有無 擷取大盤歷史資料的程式？
    或者能否分享如何自行撰寫？
    不管如何，還是感謝....

diabo

回復 9# jsleee


輸入【 ^TWII】可抓台灣加權指數.......

輸入【USDTWD=x】可抓美元兌台幣的歷史資料.....


其他指數代碼...

台灣證交所
加權指數 ^TWII
不含金融股 ^TIWI
金融保險類 ^TFNI

大陸
深圳綜合 ^SZSC
深圳成份 ^SZSC1
A股指數 ^SZSA
A股成份 ^SZSA1
B股指數 ^SZSB
B股成份 ^SZSB1

綜合指數 ^SSEC
A股指數 ^SSEA
B股指數 ^SSEB
工業指數 ^SSEI
商業指數 ^SSEM
地產指數 ^SSEP
公用事業 ^SSEU

香港證交所
恆生指數 ^HSI
金融指數 ^HSNF
公用事業指數 ^HSNU
地產指數 ^HSNP
工商指數 ^HSNC
中國企業指數 ^HSCE
中資企業指數 ^HSCC

亞太地區
中國 上海綜合指數 000001.SS
香港 恆生指數 ^HSI
台灣 加權指數 ^TWII
日本 Nikkei 225 ^N225
新加坡 海峽時報指數 ^STI
南韓 漢城綜合指數 ^KS11
印度 BSE 30 ^BSESN
印尼 雅加達指數 ^JKSE
馬來西亞 KLSE Composite ^KLSE
澳洲 All Ordinaries ^AORD
菲律賓 PSE Composite ^PSI
斯里蘭卡 All Share ^CSE

歐洲
奧地利 ATX ^ATX
法國 CAC 40 ^FCHI
德國 ^GDAX ^GDAX
英國 FTSE 100 ^FTSE

非洲/中東
埃及 CMA ^CCSI
以色列 TA-100 ^TA100

jsleee

回復 10# diabo


    非常感謝 diabo 大大的說明回復
    受益無窮....

white5168

應觀眾要求,貼出程式碼,歡迎各位多多指教

在Sheet1貼的內容

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$B$1" Then         '判斷目前使用者所輸入的位置是否在$B$1,如果是,則將B1輸入的代碼傳至GetStockPrice模組中,反之不作動作
   
3.     Call GetStockPrice(Range("B1"))         '傳入股票代碼,呼叫GetStockPrice模組
   
4.     End If
   
5. End Sub

複製代碼

在Module輸入的內容

1. Sub GetStockPrice(ByVal stockid As String)
   
2. '
   
3. ' GetStockPrice Macro
   
4. ' Amin 在 2012/5/6 錄製的巨集
   
5. 
   
6.     Call ClearQueryTablesData
   
7.    
   
8.     '透過 "外部匯入資料的方法" (就是使用QueryTabls的方法) 將歷史股價從2000/1/1到目前為止的日期,經由 Yahoo finance 抓回來存進excel活頁簿中,如果網站資料有問題,抓回來的也會是錯誤的資料
   
9.     With ActiveSheet.QueryTables.Add(Connection:= _
   
10.         "TEXT;http://ichart.finance.yahoo.com/table.csv?s=" & stockid & "&a=00&b=4&c=2000&d=" & Month(Date) & "&e=" & Day(Date) & "&f=" & Year(Date) & "&g=d&ignore=.csv" _
    
11.         , Destination:=Range("A3"))
    
12.         .Name = "stockprice"
    
13.         .FieldNames = True
    
14.         .RowNumbers = False
    
15.         .FillAdjacentFormulas = False
    
16.         .PreserveFormatting = True
    
17.         .RefreshOnFileOpen = False
    
18.         .RefreshStyle = xlOverwriteCells
    
19.         .SavePassword = False
    
20.         .SaveData = True
    
21.         .AdjustColumnWidth = True
    
22.         .RefreshPeriod = 0
    
23.         .TextFilePromptOnRefresh = False
    
24.         .TextFilePlatform = 950
    
25.         .TextFileStartRow = 1
    
26.         .TextFileParseType = xlDelimited
    
27.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
    
28.         .TextFileConsecutiveDelimiter = False
    
29.         .TextFileTabDelimiter = True
    
30.         .TextFileSemicolonDelimiter = False
    
31.         .TextFileCommaDelimiter = True
    
32.         .TextFileSpaceDelimiter = False
    
33.         .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
    
34.         .TextFileTrailingMinusNumbers = True
    
35.         .Refresh BackgroundQuery:=False
    
36.     End With
    
37. End Sub
    
38. 
    
39. Sub ClearQueryTablesData()                          '判斷當前活頁簿中是否有前一筆的資料,若有則清除,反之直接下載股價
    
40.     Dim n As Integer                                                   
    
41.     If Range("A4") <> "" Then                       '判斷目前的活頁簿是否有資料存在, 這行可以再寫的更謹慎,歡迎各位自行修改
    
42.         n = ActiveSheet.Range("A4").End(xlDown).Row '選取目前活頁簿從A4位置到最後一行的範圍
    
43.         For Each gt In ActiveSheet.QueryTables      '選取用QueryTables抓取的每一行
    
44.             gt.Delete                               '將使用QueryTables方法所產生的行進行刪除,避免QueryTables用久了,造成系統堆積一堆QueryTables的垃圾,如此系統才不會變慢(各位應該都也感覺)
    
45.         Next
    
46.         ActiveSheet.Range("A4:G" & n).Clear         '清除所選取的資料
    
47.      End If
    
48. End Sub

複製代碼