返回列表 上一主題 發帖

擷取歷史股價

擷取歷史股價

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

GetStockPrice.rar (64.71 KB)

股價下載

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

TOP

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

TOP

有看過人家用類似的方式抓資料
然後直接存檔
字典兩各字 還真難理解

TOP

回復 1# white5168

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

TOP

回復 1# white5168


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

TOP

回復 1# white5168


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

TOP

回復 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
diabo

TOP

回復 10# diabo


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

TOP

本帖最後由 white5168 於 2012-5-27 00:48 編輯

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

在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.     Call ClearQueryTablesData
  6.    
  7.     '透過 "外部匯入資料的方法" (就是使用QueryTabls的方法) 將歷史股價從2000/1/1到目前為止的日期,經由 Yahoo finance 抓回來存進excel活頁簿中,如果網站資料有問題,抓回來的也會是錯誤的資料
  8.     With ActiveSheet.QueryTables.Add(Connection:= _
  9.         "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" _
  10.         , Destination:=Range("A3"))
  11.         .Name = "stockprice"
  12.         .FieldNames = True
  13.         .RowNumbers = False
  14.         .FillAdjacentFormulas = False
  15.         .PreserveFormatting = True
  16.         .RefreshOnFileOpen = False
  17.         .RefreshStyle = xlOverwriteCells
  18.         .SavePassword = False
  19.         .SaveData = True
  20.         .AdjustColumnWidth = True
  21.         .RefreshPeriod = 0
  22.         .TextFilePromptOnRefresh = False
  23.         .TextFilePlatform = 950
  24.         .TextFileStartRow = 1
  25.         .TextFileParseType = xlDelimited
  26.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
  27.         .TextFileConsecutiveDelimiter = False
  28.         .TextFileTabDelimiter = True
  29.         .TextFileSemicolonDelimiter = False
  30.         .TextFileCommaDelimiter = True
  31.         .TextFileSpaceDelimiter = False
  32.         .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
  33.         .TextFileTrailingMinusNumbers = True
  34.         .Refresh BackgroundQuery:=False
  35.     End With
  36. End Sub

  37. Sub ClearQueryTablesData()                          '判斷當前活頁簿中是否有前一筆的資料,若有則清除,反之直接下載股價
  38.     Dim n As Integer                                                   
  39.     If Range("A4") <> "" Then                       '判斷目前的活頁簿是否有資料存在, 這行可以再寫的更謹慎,歡迎各位自行修改
  40.         n = ActiveSheet.Range("A4").End(xlDown).Row '選取目前活頁簿從A4位置到最後一行的範圍
  41.         For Each gt In ActiveSheet.QueryTables      '選取用QueryTables抓取的每一行
  42.             gt.Delete                               '將使用QueryTables方法所產生的行進行刪除,避免QueryTables用久了,造成系統堆積一堆QueryTables的垃圾,如此系統才不會變慢(各位應該都也感覺)
  43.         Next
  44.         ActiveSheet.Range("A4:G" & n).Clear         '清除所選取的資料
  45.      End If
  46. End Sub
複製代碼

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題