我有一个完美的VBA代码。我将文件复制到新计算机上,现在运行时返回错误。
添加了相同的库引用,并且我使用的是相同的Excel版本2016。
Option Explicit
Public Const firstTickerRow As Integer = 13
Sub DownloadData()
Dim frequency As String
Dim lastRow As Integer
Dim lastErrorRow As Integer
Dim lastSuccessRow As Integer
Dim stockTicker As String
Dim numStockErrors As Integer
Dim numStockSuccess As Integer
Dim startDate As String
Dim endDate As String
Dim ticker As Integer
Dim crumb As String
Dim cookie As String
Dim validCookieCrumb As Boolean
Dim sortOrderComboBox As Shape
Dim ws As Worksheet
Sheets("Analysis").Cells.ClearContents
Sheets("Filter Stocks").Cells.ClearContents
numStockErrors = 0
numStockSuccess = 0
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = 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")
'Convert user-specified calendar dates to Unix time
'***************************************************
startDate = (Sheets("Parameters").Range("startDate") - DateValue("January 1, 1970")) * 86400
endDate = (Sheets("Parameters").Range("endDate") - DateValue("January 1, 1970")) * 86400
'***************************************************
'Set date retrieval frequency
'***************************************************
If Worksheets("Parameters").Range("frequency") = "d" Then
frequency = "1d"
ElseIf Worksheets("Parameters").Range("frequency") = "w" Then
frequency = "1wk"
ElseIf Worksheets("Parameters").Range("frequency") = "m" Then
frequency = "1mo"
End If
'***************************************************
'Delete all sheets apart from Parameters sheet
'***************************************************
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "Stocks" And ws.Name <> "Analysis" And ws.Name <> "Filter Stocks" Then ws.Delete
Next
'***************************************************
'Get cookie and crumb
'***************************************************
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
If validCookieCrumb = False Then
GoTo ErrorHandler:
End If
'***************************************************
'Loop through all tickers
For ticker = firstTickerRow To lastRow
stockTicker = Worksheets("Parameters").Range("$a$" & ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
'Create a sheet for each ticker
'***************************************************
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = stockTicker
Cells(1, 1) = "Stock Quotes for " & stockTicker
'***************************************************
'Get financial data from Yahoo and write into each sheet
'getCookieCrumb() must be run before running getYahooFinanceData()
'***************************************************
Call getYahooFinanceData(stockTicker, startDate, endDate, frequency, cookie, crumb)
'***************************************************
'Populate success or fail lists
'***************************************************
lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If lastRow < 3 Then
Sheets(stockTicker).Delete
numStockErrors = numStockErrors + 1
ErrorList stockTicker, numStockErrors
GoTo NextIteration
Else
numStockSuccess = numStockSuccess + 1
If Left(stockTicker, 1) = "^" Then
SuccessList Replace(stockTicker, "^", ""), numStockSuccess
Else
SuccessList stockTicker, numStockSuccess
End If
End If
'***************************************************
'Set the preferred date format
'***************************************************
Range("a3:a" & lastRow).NumberFormat = "yyyy-mm-dd;@"
'***************************************************
'Sort by oldest date first or newest date first
'***************************************************
Set sortOrderComboBox = Sheets("Parameters").Shapes("SortOrderDropDown")
With sortOrderComboBox.ControlFormat
If .List(.Value) = "Oldest First" Then
Call SortByDate(stockTicker, "oldest")
ElseIf .List(.Value) = "Newest First" Then
Call SortByDate(stockTicker, "newest")
End If
End With
'***************************************************
'Clean up sheet names
'***************************************************
'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
'Process export and collation
'***************************************************
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.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Call Dynamic
End Sub
Sub SortByDate(ticker As String, order As String)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sortType As Variant
lastRow = Sheets(ticker).UsedRange.Rows.Count
firstRow = 2
If order = "oldest" Then
sortType = xlAscending
Else
sortType = xlDescending
End If
Worksheets(ticker).Sort.SortFields.Clear
Worksheets(ticker).Sort.SortFields.Add Key:=Sheets(ticker).Range("A" & firstRow & ":A" & lastRow), _
SortOn:=xlSortOnValues, order:=sortType, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(ticker).Sort
.SetRange Range("A" & firstRow & ":G" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
错误发生在Worksheets(ticker).Sort.SortFields.Clear
行:
错误9:下标超出范围
我不确定为什么现在会发生这种情况。