在 for 循环中刷新 Bloomberg 请求 VBA
Refreshing Bloomberg requests in a for loop VBA
我有一个 for 循环遍历证券列表并获取如下历史数据：
diter = 0
field = "px_last"
For Each d In dates
diter = diter + 1
For s = 1 To numb_sec
bbticker = securities(s)
wsSec.Range(cl & diter).Formula = _
"=BDH(""" & bbticker & """,""" & field & """,""" & d & """,""" & d & """)"
wsSec.Calculate
Next s
Next d
显然，这会导致在下一次安全启动之前数据未加载。
因为我在这个循环后保存了文件，所以每个单元格我只得到 #N/A Requesting Data。
所以我正在寻找一种方法来等待提取完成，然后再继续下一个证券和日期。
网上查了一下，发现可以用：
Application.OnTime Now + TimeValue("00:00:01"), "NextFunction"
此方法的问题：此方法仅在 1 秒后启动另一个函数。
如何将其应用到我的代码中？也许把它放在循环的末尾，或者有更好的方法从 VBA 中的 Bloomberg 获取数据？
还有，我不知道抓取需要多长时间怎么办，现在我等了1秒，但也许应该更长时间？
您每次插入 BDH 公式时都试图计算 sheet。
另一种方法（未经测试，因为我没有 Bloomberg 库）是执行以下操作：
- 禁用事件
- 执行循环插入
BDH 公式但尚未计算...
- 重新启用事件
- 调用
Application.Calculate 将执行 sheet 计算
- 等到计算完成 - 请参阅 here
- 保存sheet
示例代码如下（同样，未经测试）：
' disable events
Application.EnableEvents = False
' your code etc (but don't calculate)
diter = 0
field = "px_last"
For Each d In dates
diter = diter + 1
For s = 1 To numb_sec
bbticker = securities(s)
wsSec.Range(cl & diter).Formula = _
"=BDH(""" & bbticker & """,""" & field & """,""" & d & """,""" & d & """)"
Next s
Next d
' re-enable events
Application.EnableEvents = True
' don't just calculate the sheet - call Application.Calculate
Application.Calculate
' wait till calculation complete
'
If Not Application.CalculationState = xlDone Then
DoEvents
End If
' do save etc
' code...
离开彭博怎么样？！他和我都上过约翰霍普金斯大学，我喜欢这个人，因为他当了 12 年的纽约市长，但我看不出花那么多钱买一些你能得到的东西有什么意义免费。
从 link 下载名为 "Get Excel Spreadsheet to Download Bulk Historical Stock Data from Google Finance"
的文件
http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Samir Khan
'simulationconsultant@gmail.com
'The latest version of this spreadsheet can be downloaded from http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Please link to http://investexcel.net if you like this spreadsheet
Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal StartDate As Date, ByVal EndDate As Date, ByVal DestinationCell As String, ByVal freq As String)
Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
qurl = "http://finance.google.com/finance/historical?q=" & stockTicker
qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
"+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & MonthName(Month(EndDate), True) & _
"+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"
On Error GoTo ErrorHandler:
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Range(DestinationCell))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
ErrorHandler:
End Sub
Sub DownloadData()
Dim frequency As String
Dim numRows As Integer
Dim lastRow As Integer
Dim lastErrorRow As Integer
Dim lastSuccessRow As Integer
Dim stockTicker As String
Dim numStockErrors As Integer
Dim numStockSuccess As Integer
numStockErrors = 0
numStockSuccess = 0
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lastErrorRow = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
lastSuccessRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row
ClearErrorList lastErrorRow
ClearSuccessList lastSuccessRow
lastRow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")
'Delete all sheets apart from Parameters sheet
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then ws.Delete
Next
Application.DisplayAlerts = True
'Loop through all tickers
For ticker = 12 To lastRow
stockTicker = Worksheets("Parameters").Range("$a$" & ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
Sheets.Add After:=Sheets(Sheets.Count)
If InStr(stockTicker, ":") > 0 Then
ActiveSheet.Name = Replace(stockTicker, ":", "")
Else
ActiveSheet.Name = stockTicker
End If
Cells(1, 1) = "Stock Quotes for " & stockTicker
Call DownloadStockQuotes(stockTicker, Worksheets("Parameters").Range("$b"), Worksheets("Parameters").Range("$b"), "$a", frequency)
Columns("a:a").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
If InStr(stockTicker, ":") > 0 Then
stockTicker = Replace(stockTicker, ":", "")
End If
Sheets(stockTicker).Columns("A:G").ColumnWidth = 10
lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If lastRow < 3 Then
Application.DisplayAlerts = False
Sheets(stockTicker).Delete
numStockErrors = numStockErrors + 1
ErrorList stockTicker, numStockErrors
GoTo NextIteration
Application.DisplayAlerts = True
Else
numStockSuccess = numStockSuccess + 1
If Left(stockTicker, 1) = "^" Then
SuccessList Replace(stockTicker, "^", ""), numStockSuccess
Else
SuccessList stockTicker, numStockSuccess
End If
End If
Sheets(stockTicker).Sort.SortFields.Add Key:=Range("A3:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets(stockTicker).Sort
.SetRange Range("A2:G" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("a3:a" & lastRow).NumberFormat = "yyyy-mm-dd;@"
'Delete final blank row otherwise will get ,,,, at bottom of CSV
Sheets(stockTicker).Rows(lastRow + 1 & ":" & Sheets(stockTicker).Rows.Count).Delete
'Remove initial ^ in ticker names from Sheets
If Left(stockTicker, 1) = "^" Then
ActiveSheet.Name = Replace(stockTicker, "^", "")
Else
ActiveSheet.Name = stockTicker
End If
'Remove hyphens in ticker names from Sheet names, otherwise error in collation
If InStr(stockTicker, "-") > 0 Then
ActiveSheet.Name = Replace(stockTicker, "-", "")
End If
NextIteration:
Next ticker
Application.DisplayAlerts = False
If Sheets("Parameters").Shapes("WriteToCSVCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CopyToCSV
End If
If Sheets("Parameters").Shapes("CollateDataCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CollateData
End If
ErrorHandler:
Worksheets("Parameters").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Worksheets("Parameters").Select
For Each C In ThisWorkbook.Connections
C.Delete
Next
End Sub
Sub CollateData()
Dim ws As Worksheet
Dim i As Integer, first As Integer
Dim maxRow As Integer
Dim maxTickerWS As Worksheet
maxRow = 0
For Each ws In Worksheets
If ws.Name <> "Parameters" Then
If ws.UsedRange.Rows.Count > maxRow Then
maxRow = ws.UsedRange.Rows.Count
Set maxTickerWS = ws
End If
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Open"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "High"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Low"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Close"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Volume"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Adjusted Close"
i = 1
maxTickerWS.Range("A2", "B" & maxRow).Copy Destination:=Sheets("Open").Cells(1, i)
Sheets("Open").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("High").Cells(1, i)
maxTickerWS.Range("c2", "c" & maxRow).Copy Destination:=Sheets("High").Cells(1, i + 1)
Sheets("High").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Low").Cells(1, i)
maxTickerWS.Range("d2", "d" & maxRow).Copy Destination:=Sheets("Low").Cells(1, i + 1)
Sheets("Low").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Close").Cells(1, i)
maxTickerWS.Range("e2", "e" & maxRow).Copy Destination:=Sheets("Close").Cells(1, i + 1)
Sheets("Close").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Volume").Cells(1, i)
maxTickerWS.Range("f2", "f" & maxRow).Copy Destination:=Sheets("Volume").Cells(1, i + 1)
Sheets("Volume").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Adjusted Close").Cells(1, i)
maxTickerWS.Range("g2", "g" & maxRow).Copy Destination:=Sheets("Adjusted Close").Cells(1, i + 1)
Sheets("Adjusted Close").Cells(1, i + 1) = maxTickerWS.Name
i = i + 2
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" And ws.Name <> maxTickerWS.Name And ws.Name <> "Open" And ws.Name <> "High" And ws.Name <> "Low" And ws.Name <> "Close" And ws.Name <> "Volume" And ws.Name <> "Adjusted Close" Then
Sheets("Open").Cells(1, i) = ws.Name
Sheets("Open").Range(Sheets("Open").Cells(2, i), Sheets("Open").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",2,0)"
Sheets("High").Cells(1, i) = ws.Name
Sheets("High").Range(Sheets("High").Cells(2, i), Sheets("High").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",3,0)"
Sheets("Low").Cells(1, i) = ws.Name
Sheets("Low").Range(Sheets("Low").Cells(2, i), Sheets("Low").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",4,0)"
Sheets("Close").Cells(1, i) = ws.Name
Sheets("Close").Range(Sheets("Close").Cells(2, i), Sheets("Close").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",5,0)"
Sheets("Volume").Cells(1, i) = ws.Name
Sheets("Volume").Range(Sheets("Volume").Cells(2, i), Sheets("Volume").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",6,0)"
Sheets("Adjusted Close").Cells(1, i) = ws.Name
Sheets("Adjusted Close").Range(Sheets("Adjusted Close").Cells(2, i), Sheets("Adjusted Close").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",7,0)"
i = i + 1
End If
Next
On Error Resume Next
Sheets("Open").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Close").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("High").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Low").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Volume").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Adjusted Close").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
On Error GoTo 0
Sheets("Open").Columns("A:A").EntireColumn.AutoFit
Sheets("High").Columns("A:A").EntireColumn.AutoFit
Sheets("Low").Columns("A:A").EntireColumn.AutoFit
Sheets("Close").Columns("A:A").EntireColumn.AutoFit
Sheets("Volume").Columns("A:A").EntireColumn.AutoFit
Sheets("Adjusted Close").Columns("A:A").EntireColumn.AutoFit
End Sub
Sub SuccessList(ByVal stockTicker As String, ByVal numStockSuccess As Integer)
Sheets("Parameters").Range("L" & 10 + numStockSuccess) = stockTicker
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ErrorList(ByVal stockTicker As String, ByVal numStockErrors As Integer)
Sheets("Parameters").Range("J" & 10 + numStockErrors) = stockTicker
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ClearErrorList(ByVal lastErrorRow As Integer)
If lastErrorRow > 10 Then
Worksheets("Parameters").Range("J11:J" & lastErrorRow).Clear
With Sheets("Parameters").Range("J10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub ClearSuccessList(ByVal lastSuccessRow As Integer)
If lastSuccessRow > 10 Then
Worksheets("Parameters").Range("L11:L" & lastSuccessRow).Clear
With Sheets("Parameters").Range("L10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
dateFrom = Worksheets("Parameters").Range("$b")
dateTo = Worksheets("Parameters").Range("$b")
frequency = Worksheets("Parameters").Range("$b")
MyPath = Worksheets("Parameters").Range("$b")
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then
ticker = ws.Name
MyFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets(ticker).Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End If
Next
End Sub
我有一个 for 循环遍历证券列表并获取如下历史数据：
diter = 0
field = "px_last"
For Each d In dates
diter = diter + 1
For s = 1 To numb_sec
bbticker = securities(s)
wsSec.Range(cl & diter).Formula = _
"=BDH(""" & bbticker & """,""" & field & """,""" & d & """,""" & d & """)"
wsSec.Calculate
Next s
Next d
显然，这会导致在下一次安全启动之前数据未加载。
因为我在这个循环后保存了文件，所以每个单元格我只得到 #N/A Requesting Data。
所以我正在寻找一种方法来等待提取完成，然后再继续下一个证券和日期。
网上查了一下，发现可以用：
Application.OnTime Now + TimeValue("00:00:01"), "NextFunction"
此方法的问题：此方法仅在 1 秒后启动另一个函数。
如何将其应用到我的代码中？也许把它放在循环的末尾，或者有更好的方法从 VBA 中的 Bloomberg 获取数据？
还有，我不知道抓取需要多长时间怎么办，现在我等了1秒，但也许应该更长时间？
您每次插入 BDH 公式时都试图计算 sheet。
另一种方法（未经测试，因为我没有 Bloomberg 库）是执行以下操作：
- 禁用事件
- 执行循环插入
BDH公式但尚未计算... - 重新启用事件
- 调用
Application.Calculate将执行 sheet 计算 - 等到计算完成 - 请参阅 here
- 保存sheet
示例代码如下（同样，未经测试）：
' disable events
Application.EnableEvents = False
' your code etc (but don't calculate)
diter = 0
field = "px_last"
For Each d In dates
diter = diter + 1
For s = 1 To numb_sec
bbticker = securities(s)
wsSec.Range(cl & diter).Formula = _
"=BDH(""" & bbticker & """,""" & field & """,""" & d & """,""" & d & """)"
Next s
Next d
' re-enable events
Application.EnableEvents = True
' don't just calculate the sheet - call Application.Calculate
Application.Calculate
' wait till calculation complete
'
If Not Application.CalculationState = xlDone Then
DoEvents
End If
' do save etc
' code...
离开彭博怎么样？！他和我都上过约翰霍普金斯大学，我喜欢这个人，因为他当了 12 年的纽约市长，但我看不出花那么多钱买一些你能得到的东西有什么意义免费。
从 link 下载名为 "Get Excel Spreadsheet to Download Bulk Historical Stock Data from Google Finance"
的文件http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Samir Khan
'simulationconsultant@gmail.com
'The latest version of this spreadsheet can be downloaded from http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Please link to http://investexcel.net if you like this spreadsheet
Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal StartDate As Date, ByVal EndDate As Date, ByVal DestinationCell As String, ByVal freq As String)
Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
qurl = "http://finance.google.com/finance/historical?q=" & stockTicker
qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
"+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & MonthName(Month(EndDate), True) & _
"+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"
On Error GoTo ErrorHandler:
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Range(DestinationCell))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
ErrorHandler:
End Sub
Sub DownloadData()
Dim frequency As String
Dim numRows As Integer
Dim lastRow As Integer
Dim lastErrorRow As Integer
Dim lastSuccessRow As Integer
Dim stockTicker As String
Dim numStockErrors As Integer
Dim numStockSuccess As Integer
numStockErrors = 0
numStockSuccess = 0
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lastErrorRow = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
lastSuccessRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row
ClearErrorList lastErrorRow
ClearSuccessList lastSuccessRow
lastRow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")
'Delete all sheets apart from Parameters sheet
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then ws.Delete
Next
Application.DisplayAlerts = True
'Loop through all tickers
For ticker = 12 To lastRow
stockTicker = Worksheets("Parameters").Range("$a$" & ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
Sheets.Add After:=Sheets(Sheets.Count)
If InStr(stockTicker, ":") > 0 Then
ActiveSheet.Name = Replace(stockTicker, ":", "")
Else
ActiveSheet.Name = stockTicker
End If
Cells(1, 1) = "Stock Quotes for " & stockTicker
Call DownloadStockQuotes(stockTicker, Worksheets("Parameters").Range("$b"), Worksheets("Parameters").Range("$b"), "$a", frequency)
Columns("a:a").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
If InStr(stockTicker, ":") > 0 Then
stockTicker = Replace(stockTicker, ":", "")
End If
Sheets(stockTicker).Columns("A:G").ColumnWidth = 10
lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If lastRow < 3 Then
Application.DisplayAlerts = False
Sheets(stockTicker).Delete
numStockErrors = numStockErrors + 1
ErrorList stockTicker, numStockErrors
GoTo NextIteration
Application.DisplayAlerts = True
Else
numStockSuccess = numStockSuccess + 1
If Left(stockTicker, 1) = "^" Then
SuccessList Replace(stockTicker, "^", ""), numStockSuccess
Else
SuccessList stockTicker, numStockSuccess
End If
End If
Sheets(stockTicker).Sort.SortFields.Add Key:=Range("A3:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets(stockTicker).Sort
.SetRange Range("A2:G" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("a3:a" & lastRow).NumberFormat = "yyyy-mm-dd;@"
'Delete final blank row otherwise will get ,,,, at bottom of CSV
Sheets(stockTicker).Rows(lastRow + 1 & ":" & Sheets(stockTicker).Rows.Count).Delete
'Remove initial ^ in ticker names from Sheets
If Left(stockTicker, 1) = "^" Then
ActiveSheet.Name = Replace(stockTicker, "^", "")
Else
ActiveSheet.Name = stockTicker
End If
'Remove hyphens in ticker names from Sheet names, otherwise error in collation
If InStr(stockTicker, "-") > 0 Then
ActiveSheet.Name = Replace(stockTicker, "-", "")
End If
NextIteration:
Next ticker
Application.DisplayAlerts = False
If Sheets("Parameters").Shapes("WriteToCSVCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CopyToCSV
End If
If Sheets("Parameters").Shapes("CollateDataCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CollateData
End If
ErrorHandler:
Worksheets("Parameters").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Worksheets("Parameters").Select
For Each C In ThisWorkbook.Connections
C.Delete
Next
End Sub
Sub CollateData()
Dim ws As Worksheet
Dim i As Integer, first As Integer
Dim maxRow As Integer
Dim maxTickerWS As Worksheet
maxRow = 0
For Each ws In Worksheets
If ws.Name <> "Parameters" Then
If ws.UsedRange.Rows.Count > maxRow Then
maxRow = ws.UsedRange.Rows.Count
Set maxTickerWS = ws
End If
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Open"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "High"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Low"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Close"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Volume"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Adjusted Close"
i = 1
maxTickerWS.Range("A2", "B" & maxRow).Copy Destination:=Sheets("Open").Cells(1, i)
Sheets("Open").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("High").Cells(1, i)
maxTickerWS.Range("c2", "c" & maxRow).Copy Destination:=Sheets("High").Cells(1, i + 1)
Sheets("High").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Low").Cells(1, i)
maxTickerWS.Range("d2", "d" & maxRow).Copy Destination:=Sheets("Low").Cells(1, i + 1)
Sheets("Low").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Close").Cells(1, i)
maxTickerWS.Range("e2", "e" & maxRow).Copy Destination:=Sheets("Close").Cells(1, i + 1)
Sheets("Close").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Volume").Cells(1, i)
maxTickerWS.Range("f2", "f" & maxRow).Copy Destination:=Sheets("Volume").Cells(1, i + 1)
Sheets("Volume").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Adjusted Close").Cells(1, i)
maxTickerWS.Range("g2", "g" & maxRow).Copy Destination:=Sheets("Adjusted Close").Cells(1, i + 1)
Sheets("Adjusted Close").Cells(1, i + 1) = maxTickerWS.Name
i = i + 2
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" And ws.Name <> maxTickerWS.Name And ws.Name <> "Open" And ws.Name <> "High" And ws.Name <> "Low" And ws.Name <> "Close" And ws.Name <> "Volume" And ws.Name <> "Adjusted Close" Then
Sheets("Open").Cells(1, i) = ws.Name
Sheets("Open").Range(Sheets("Open").Cells(2, i), Sheets("Open").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",2,0)"
Sheets("High").Cells(1, i) = ws.Name
Sheets("High").Range(Sheets("High").Cells(2, i), Sheets("High").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",3,0)"
Sheets("Low").Cells(1, i) = ws.Name
Sheets("Low").Range(Sheets("Low").Cells(2, i), Sheets("Low").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",4,0)"
Sheets("Close").Cells(1, i) = ws.Name
Sheets("Close").Range(Sheets("Close").Cells(2, i), Sheets("Close").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",5,0)"
Sheets("Volume").Cells(1, i) = ws.Name
Sheets("Volume").Range(Sheets("Volume").Cells(2, i), Sheets("Volume").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",6,0)"
Sheets("Adjusted Close").Cells(1, i) = ws.Name
Sheets("Adjusted Close").Range(Sheets("Adjusted Close").Cells(2, i), Sheets("Adjusted Close").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A:G$" & maxRow & ",7,0)"
i = i + 1
End If
Next
On Error Resume Next
Sheets("Open").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Close").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("High").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Low").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Volume").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Adjusted Close").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
On Error GoTo 0
Sheets("Open").Columns("A:A").EntireColumn.AutoFit
Sheets("High").Columns("A:A").EntireColumn.AutoFit
Sheets("Low").Columns("A:A").EntireColumn.AutoFit
Sheets("Close").Columns("A:A").EntireColumn.AutoFit
Sheets("Volume").Columns("A:A").EntireColumn.AutoFit
Sheets("Adjusted Close").Columns("A:A").EntireColumn.AutoFit
End Sub
Sub SuccessList(ByVal stockTicker As String, ByVal numStockSuccess As Integer)
Sheets("Parameters").Range("L" & 10 + numStockSuccess) = stockTicker
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ErrorList(ByVal stockTicker As String, ByVal numStockErrors As Integer)
Sheets("Parameters").Range("J" & 10 + numStockErrors) = stockTicker
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ClearErrorList(ByVal lastErrorRow As Integer)
If lastErrorRow > 10 Then
Worksheets("Parameters").Range("J11:J" & lastErrorRow).Clear
With Sheets("Parameters").Range("J10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub ClearSuccessList(ByVal lastSuccessRow As Integer)
If lastSuccessRow > 10 Then
Worksheets("Parameters").Range("L11:L" & lastSuccessRow).Clear
With Sheets("Parameters").Range("L10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
dateFrom = Worksheets("Parameters").Range("$b")
dateTo = Worksheets("Parameters").Range("$b")
frequency = Worksheets("Parameters").Range("$b")
MyPath = Worksheets("Parameters").Range("$b")
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then
ticker = ws.Name
MyFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets(ticker).Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End If
Next
End Sub