- 帖子
- 90
- 主題
- 16
- 精華
- 0
- 積分
- 114
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- sp2
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-7-9
- 最後登錄
- 2018-10-7
|
10#
發表於 2012-5-27 00:28
| 只看該作者
本帖最後由 white5168 於 2012-5-27 00:48 編輯
應觀眾要求,貼出程式碼,歡迎各位多多指教
在Sheet1貼的內容- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Address = "$B$1" Then '判斷目前使用者所輸入的位置是否在$B$1,如果是,則將B1輸入的代碼傳至GetStockPrice模組中,反之不作動作
- Call GetStockPrice(Range("B1")) '傳入股票代碼,呼叫GetStockPrice模組
- End If
- End Sub
- Sub GetStockPrice(ByVal stockid As String)
- '
- ' GetStockPrice Macro
- ' Amin 在 2012/5/6 錄製的巨集
- Call ClearQueryTablesData
-
- '透過 "外部匯入資料的方法" (就是使用QueryTabls的方法) 將歷史股價從2000/1/1到目前為止的日期,經由 Yahoo finance 抓回來存進excel活頁簿中,如果網站資料有問題,抓回來的也會是錯誤的資料
- With ActiveSheet.QueryTables.Add(Connection:= _
- "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" _
- , Destination:=Range("A3"))
- .Name = "stockprice"
- .FieldNames = True
- .RowNumbers = False
- .FillAdjacentFormulas = False
- .PreserveFormatting = True
- .RefreshOnFileOpen = False
- .RefreshStyle = xlOverwriteCells
- .SavePassword = False
- .SaveData = True
- .AdjustColumnWidth = True
- .RefreshPeriod = 0
- .TextFilePromptOnRefresh = False
- .TextFilePlatform = 950
- .TextFileStartRow = 1
- .TextFileParseType = xlDelimited
- .TextFileTextQualifier = xlTextQualifierDoubleQuote
- .TextFileConsecutiveDelimiter = False
- .TextFileTabDelimiter = True
- .TextFileSemicolonDelimiter = False
- .TextFileCommaDelimiter = True
- .TextFileSpaceDelimiter = False
- .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
- .TextFileTrailingMinusNumbers = True
- .Refresh BackgroundQuery:=False
- End With
- End Sub
- Sub ClearQueryTablesData() '判斷當前活頁簿中是否有前一筆的資料,若有則清除,反之直接下載股價
- Dim n As Integer
- If Range("A4") <> "" Then '判斷目前的活頁簿是否有資料存在, 這行可以再寫的更謹慎,歡迎各位自行修改
- n = ActiveSheet.Range("A4").End(xlDown).Row '選取目前活頁簿從A4位置到最後一行的範圍
- For Each gt In ActiveSheet.QueryTables '選取用QueryTables抓取的每一行
- gt.Delete '將使用QueryTables方法所產生的行進行刪除,避免QueryTables用久了,造成系統堆積一堆QueryTables的垃圾,如此系統才不會變慢(各位應該都也感覺)
- Next
- ActiveSheet.Range("A4:G" & n).Clear '清除所選取的資料
- End If
- End Sub
|
|
