运行时'6‘溢出错误-用于股票分析的重构代码

Question

我正在尝试重构代码，该代码分析12个报价器，然后返回它们各自的总成交量，但我在步骤3a收到一个溢出错误，并且我找不出原因

tickerVolumes(tickerIndex) = tickerVolumes(tickerIndex) + Cells(i, 8).Value

我是VBA的新手，我希望得到一些指导，而不是完全重写，但对所有建议都持开放态度！

Sub AllStocksAnalysisRefactored()

    Dim startTime As Single
    Dim endTime  As Single

    yearValue = InputBox("What year would you like to run the analysis on?")

    startTime = Timer
    
    'Format the output sheet on All Stocks Analysis worksheet
    Worksheets("All Stocks Analysis").Activate
    
    Range("A1").Value = "All Stocks (" + yearValue + ")"
    
    'Create a header row
    Cells(3, 1).Value = "Ticker"
    Cells(3, 2).Value = "Total Daily Volume"
    Cells(3, 3).Value = "Return"

    'Initialize array of all tickers
    Dim tickers(12) As String
    
    tickers(0) = "AY"
    tickers(1) = "CSIQ"
    tickers(2) = "DQ"
    tickers(3) = "ENPH"
    tickers(4) = "FSLR"
    tickers(5) = "HASI"
    tickers(6) = "JKS"
    tickers(7) = "RUN"
    tickers(8) = "SEDG"
    tickers(9) = "SPWR"
    tickers(10) = "TERP"
    tickers(11) = "VSLR"
    
    'Activate data worksheet
    Worksheets(yearValue).Activate
    
    'Get the number of rows to loop over
    RowCount = Cells(Rows.Count, "A").End(xlUp).Row
    
    '1a) Create a ticker Index
    Dim tickerIndex As Single
    tickerIndex = 0

    '1b) Create three output arrays
    Dim tickerVolumes(12) As Long
    Dim tickerStartingPrices(12) As Single
    Dim tickerEndingPrices(12) As Single
    
    ''2a) Create a for loop to initialize the tickerVolumes to zero.
    For tickerIndex = 0 To 11
        
        ticker = tickers(tickerIndex)
        tickerVolumes(tickerIndex) = 0
    
    ''2b) Loop over all the rows in the spreadsheet.
        For i = 2 To RowCount
    
        '3a) Increase volume for current ticker
            tickerVolumes(tickerIndex) = tickerVolumes(tickerIndex) + Cells(i, 8).Value
        
        '3b) Check if the current row is the first row with the selected tickerIndex.
            If Cells(i - 1, 1).Value <> ticker And Cells(i, 1).Value = ticker Then
            
                tickerStartingPrices(tickerIndex) = Cells(i, 6).Value
            
            End If
        
        '3c) check if the current row is the last row with the selected ticker
        
            If Cells(i + 1, 1).Value <> ticker And Cells(i, 1).Value = ticker Then
         
                tickerEndingPrices(tickerIndex) = Cells(i, 6).Value

            '3d Increase the tickerIndex.
                tickerIndex = tickerIndex + 1
            
            End If
        
        Next i
        
    Next tickerIndex
    
    '4) Loop through your arrays to output the Ticker, Total Daily Volume, and Return.
    For i = 0 To 11
        
        Worksheets("All Stocks Analysis").Activate
        Cells(4 + i, 1).Value = ticker
        Cells(4 + i, 2).Value = totalVolumes
        Cells(4 + i, 3).Value = tickerEndingPrices(tickerIndex) / tickerStartingPrices(tickerIndex) - 1
        
    Next i
    
    'Formatting
    Worksheets("All Stocks Analysis").Activate
    Range("A3:C3").Font.FontStyle = "Bold"
    Range("A3:C3").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("B4:B15").NumberFormat = "#,##0"
    Range("C4:C15").NumberFormat = "0.0%"
    Columns("B").AutoFit

    dataRowStart = 4
    dataRowEnd = 15

    For i = dataRowStart To dataRowEnd
        
        If Cells(i, 3) > 0 Then
            
            Cells(i, 3).Interior.Color = vbGreen
            
        Else
        
            Cells(i, 3).Interior.Color = vbRed
            
        End If
        
    Next i
 
    endTime = Timer
    MsgBox "This code ran in " & (endTime - startTime) & " seconds for the year " & (yearValue)

End Sub

下面是我正在处理的数据集的屏幕截图- 2018 Stock Data Snippet

2018年的结果如下所示：

2018 Total Daily Volume

Answer 1

使用vba时，目标是尽可能少地与工作表交互。将信息加载到内存(数组)，操作源，仅在末尾转储回工作表。

下面是我认为应该如何做的，它将以指数级的速度增长，并展示数组和字典：

Option Explicit
Sub AllStocksAnalysisRefactored2()
    '''''''''''''''''
    'Set some vars and get data from sheet in array
    '''''''''''''''''
    Dim yearValue As String, startTime As Single, arrh, sh As Worksheet, arrt, arr
    yearValue = InputBox("What year would you like to run the analysis on?")
    startTime = Timer
    arrh = Array("Ticker", "Total Daily Volume", "Return")
    Set sh = ThisWorkbook.Sheets(yearValue)
    arr = Sheet1.Range("A1").CurrentRegion.Value2 'assuming you have data as of A1 we store all in the array, you can fine tune if needed though
    arrt = dedubcol(arr, 1) 'instead of hardcoding your tickers we get them from the source removing duplicates. to keep code clean we use a function to do this
    
    '''''''''''''''''
    'Set headers & dictionary
    '''''''''''''''''
    Dim dict As Object, j As Long, arrFinal, total As Long, startv As Long, totalv As Long, counter As Long: counter = 1
    ReDim arrFinal(0 To UBound(arrt), 0 To UBound(arrh))
    For j = 0 To UBound(arrh)
        arrFinal(0, j) = arrh(j)
    Next j
    Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
   
    '''''''''''''''''
    'Loop trough source, calculate and save to target array
    '''''''''''''''''
    'here we can access each cell by referencing our array(<rowCounter>, <columnCounter>
    'e.g. arr(j,i) => if j = 1 and i = 1 we'll have the values of Cell A1
    'we can dump these values anywhere in the activesheet, other sheet, other workbook, .. but to limit the number of interactions with our sheet object we can also create new, intermediant arrays
    'e.g. we could now copy cel by cel to the new sheet => Sheets(arr(j,1).Range(... but this would create significant overhead
    'so we'll use an intermediant array (arrFinal) to store the results
            
    'We use a "dictionary" to match values in vba
    With dict 'used because I'm to lazy to retype dict everywhere :)
        .CompareMode = 1 'textcompare
        For j = 2 To UBound(arr) 'traverse source
            If .Count > counter Then ' check if it's a new ticker. If it is, calculate the result
                arrFinal(counter, 2) = arr(j - 2, 8) / arrFinal(.Count - 1, 2) 'end / start => [j - 2 = the last value of the previous ticker, 8 = the col] [.Count = the occurance in the dictionary]
                counter = counter + 1
            End If
            If Not .Exists(arr(j, 1)) Then 'check if it's the first occurance of the ticker
                .Add Key:=arr(j, 1), Item:=arr(j, 1) 'add ticker to dictionary key & item
                arrFinal(.Count, 0) = arr(j, 1) 'Add ticker in first col of final array
                arrFinal(.Count, 2) = arr(j, 8) 'Add start value in 3rd col of final array, just temporary placeholder
                totalv = arr(j, 8) 'sum
            ElseIf arr(j, 1) = dict(arr(j, 1)) Then 'if it's the same ticker add to sum
                totalv = totalv + arr(j, 8) 'sum
                arrFinal(.Count, 1) = totalv 'total
            End If
            If j = UBound(arr) Then 'if it's the last row
                arrFinal(.Count, 2) = arr(j, 8) / arrFinal(counter, 2) 'end / start
            End If
        Next j
    End With
    
    '''''''''''''''''
    'Dumb to sheet only at the end, you can add your formating here
    '''''''''''''''''
    With Sheet2
        .Range(.Cells(1, 1), .Cells(UBound(arrFinal) + 1, UBound(arrFinal, 2) + 1)).Value2 = arrFinal 'dumb to sheet
    End With
    
    '''''''''''''''''
    'Cleanup, this were you would add an errorhandler
    '''''''''''''''''
    Dim endTime As Single
    endTime = Timer
    MsgBox "This code ran in " & (endTime - startTime) & " seconds for the year " & (yearValue)
End Sub

Function dedubcol(arr, colnr As Long) As Variant
    '''''''''''''''''
    'other example how usefull dictionaries are.
    '''''''''''''''''
    Dim j As Long, dict As Object
    Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
    With dict
        For j = LBound(arr) To UBound(arr) 'use the size of the arr to set for loop
            If IsMissing(arr(j, colnr)) = False Then 'alternative to not exist.
                .Item(arr(j, colnr)) = 1 'add unique values to dict
            End If
        Next
        dedubcol = .Keys 'by using the function name we send back the result to the caller var
    End With
End Function