更换笔记本电脑时,为什么我的VBA代码返回错误?

时间:2019-01-20 15:00:15

标签: excel vba

我有一个完美的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:下标超出范围

我不确定为什么现在会发生这种情况。

0 个答案:

没有答案