运行时'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年股票数据摘要

2018年的结果如下:

2018年日成交总量

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