《量化投资:以MATLAB为工具》

MATLAB技术论坛

 找回密码
 注册账号
查看: 27714|回复: 280
收起左侧

[源码] VBA源代码-Excel版本从Yahoo获得实时数据和历史数据

  [复制链接]
发表于 2012-1-13 17:02:56 | 显示全部楼层 |阅读模式
本帖最后由 faruto 于 2012-1-13 17:04 编辑

此帖子和下面这个帖子相关
Excel版本从Yahoo获得实时数据和历史数据
http://www.matlabsky.com/thread-22245-1-1.html



下面给出上面帖子的VBA源代码:

代码不难,会VBA看看,大概就能明白了。

从Yahoo获得实时数据 VBA
  1. Sub GetData()

  2.     Dim QuerySheet As Worksheet
  3.     Dim DataSheet As Worksheet
  4.     Dim qurl As String
  5.     Dim i As Integer
  6.    
  7.     Application.ScreenUpdating = False
  8.     Application.DisplayAlerts = False
  9.     Application.Calculation = xlCalculationManual
  10.    
  11.     Set DataSheet = ActiveSheet
  12.   
  13.     Range("C7").CurrentRegion.ClearContents
  14.     i = 7
  15.     qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
  16.     i = i + 1
  17.     While Cells(i, 1) <> ""
  18.         qurl = qurl + "+" + Cells(i, 1)
  19.         i = i + 1
  20.     Wend
  21.     qurl = qurl + "&f=" + Range("C2")
  22.     Range("c1") = qurl
  23. QueryQuote:
  24.              With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
  25.                 .BackgroundQuery = True
  26.                 .TablesOnlyFromHTML = False
  27.                 .Refresh BackgroundQuery:=False
  28.                 .SaveData = True
  29.             End With
  30.             
  31.             Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
  32.                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  33.                 Semicolon:=False, Comma:=True, Space:=False, other:=False
  34.                         
  35.    
  36. 'turn calculation back on
  37.     Application.Calculation = xlCalculationAutomatic
  38.     Application.DisplayAlerts = True
  39. '    Range("C7:H2000").Select
  40. '    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
  41. '        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  42.     Columns("C:C").ColumnWidth = 12
  43.     Columns("J:J").ColumnWidth = 25.43
  44.     Range("h2").Select

  45. End Sub
复制代码



从Yahoo下载历史数据 VBA


  1. Sub GetData()
  2. '   thanks to Ron McEwan :^)

  3.     Dim QuerySheet As Worksheet
  4.     Dim DataSheet As Worksheet
  5.     Dim EndDate As Date
  6.     Dim StartDate As Date
  7.     Dim Symbol As String
  8.     Dim qurl As String
  9.     Dim nQuery As Name
  10.    
  11.     Application.ScreenUpdating = False
  12.     Application.DisplayAlerts = False
  13.     Application.Calculation = xlCalculationManual
  14.    
  15.     Set DataSheet = ActiveSheet
  16.   
  17.         StartDate = DataSheet.Range("B2").Value
  18.         EndDate = DataSheet.Range("B3").Value
  19.         Symbol = DataSheet.Range("B4").Value
  20.         Range("C7").CurrentRegion.ClearContents
  21.         
  22. 'construct the URL for the query
  23.         
  24.         qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol
  25.         qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
  26.             "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
  27.             Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _
  28.             Symbol & "&x=.csv"
  29.         Range("c5") = qurl
  30.                   
  31. QueryQuote:
  32.              With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
  33.                 .BackgroundQuery = True
  34.                 .TablesOnlyFromHTML = False
  35.                 .Refresh BackgroundQuery:=False
  36.                 .SaveData = True
  37.             End With
  38.             
  39.             Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
  40.                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  41.                 Semicolon:=False, Comma:=True, Space:=False, other:=False
  42.             
  43.             Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
  44.             Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
  45.             Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
  46.             Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"


  47.     With ThisWorkbook
  48.         For Each nQuery In Names
  49.             If IsNumeric(Right(nQuery.Name, 1)) Then
  50.                 nQuery.Delete
  51.             End If
  52.         Next nQuery
  53.     End With
  54.    
  55. 'turn calculation back on
  56.     Application.Calculation = xlCalculationAutomatic
  57.     Application.DisplayAlerts = True
  58.     Range("C7:I3000").Select
  59.     Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
  60.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  61.         
  62.     'UpdateScale
  63.    
  64.     Range("B4").Select

  65. End Sub

  66. Sub UpdateScale()
  67. Dim ChartVar As chart
  68. Dim lMax As Long, lMin As Long

  69. On Error GoTo ScalingProblem
  70.     'Assigns the values in the Min and Max ranges to variables.
  71.     With Sheet1
  72.         lMax = .Range("Max").Value
  73.         lMin = .Range("Min").Value
  74.         'Creates chart object.
  75.         Set ChartVar = .ChartObjects("Chart 32").chart
  76.      
  77.             
  78.                With ChartVar.Axes(xlValue, xlPrimary)  'Adjusts the price axis
  79.                    .MinimumScale = lMin
  80.                    .MaximumScale = lMax
  81.                End With
  82.             
  83.     End With
  84. Exit Sub

  85. ScalingProblem:
  86. RetrievalProblem:
  87.     MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling Error"
  88. End Sub
复制代码



评分

参与人数 1贝壳 +8 贡献 +8 收起 理由
fantuanxiaot + 8 + 8

查看全部评分

发表于 2015-11-2 19:01:47 | 显示全部楼层

RE: VBA源代码-Excel版本从Yahoo获得实时数据和历史数据

VBA源代码-Excel版本从Yahoo获得实时数据和历史数据
回复 支持 反对

使用道具 举报

发表于 2016-9-26 23:02:33 | 显示全部楼层
学习以下学习以下学习以下学习以下学习以下
回复 支持 反对

使用道具 举报

发表于 2016-4-4 20:57:31 | 显示全部楼层
学习以下学习以下学习以下学习以下学习以下
回复 支持 反对

使用道具 举报

发表于 2012-1-13 17:32:35 | 显示全部楼层
生生世世事实上实施
发表于 2012-1-13 18:41:34 | 显示全部楼层
发表于 2012-1-13 20:11:44 | 显示全部楼层
发表于 2012-1-13 20:56:43 | 显示全部楼层
发表于 2012-1-13 21:56:57 | 显示全部楼层
发表于 2012-1-13 21:56:57 | 显示全部楼层
发表于 2012-1-13 23:12:16 | 显示全部楼层
发表于 2012-1-13 23:42:18 | 显示全部楼层
发表于 2012-1-14 00:27:40 | 显示全部楼层
您需要登录后才可以回帖 登录 | 注册账号

本版积分规则

QQ|网站地图|MATLAB技术论坛|Simulink仿真论坛 ( 蜀ICP备19014457号 

GMT+8, 2020-8-6 06:09 , Processed in 0.064951 second(s), 18 queries , Gzip On, MemCached On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表