標題: [發問] 運用VBA抓取Yahoo Finance APIs股票資料 [打印本頁]

---

作者: 杏仁果子    時間: 2015-1-28 11:14     標題: 運用VBA抓取Yahoo Finance APIs股票資料

在網路上找到此抓取股價的方式，但無法順利寫入巨集中，讓試算表一開啟即可更新股價！
是哪個地方出錯了？


'宣告變數
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim i As Integer
   
'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
   
'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
  
'從第七列開始，只要第一欄（A欄）內容不是空的，就把代碼加到Yahoo Finance API的網址中
    Range("C7").CurrentRegion.ClearContents
    i = 7
    qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
    i = i + 1
    While Cells(i, 1) <> ""
        qurl = qurl + "+" + Cells(i, 1)
        i = i + 1
    Wend
    qurl = qurl + "&f=" + Range("C2")
'將網址放到C1的欄位中
    Range("c1") = qurl
'抓取資料
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
            
'將CSV的格式塞到Excel的表格當中
            Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False
                        
   
'讓Excel重新活回來，讓資料能夠顯示
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'    Range("C7:H2000").Select
'    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
'        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns("C:C").ColumnWidth = 12
    Columns("J:J").ColumnWidth = 25.43
    Range("h2").Select

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)