优化我的VBA代码,所以它运行更快/股票价格计算

我需要优化我的代码,所以它运行得更快。 它只有12000个计算。 我的工作表中有大约6 000行,我需要计算一列的回报率和另一列的对数回报率。

问题是,当我用Excel公式进行这些计数时,每列需要2-3秒,所以6 000行的收益率在2秒内计算,而在第二列中的对数收益率也是如此。 但是我的代码需要60秒才能运行。 这怎么可能呢? 我确信VBA计算将会比这更快。

Sub Normal_Return_Rate() Dim ws As Worksheet Dim current_price As Single Dim previous_price As Single Dim a_cell As Range Dim b_cell As Range Dim vba_cell As Range Dim row As Long Dim b_col As Integer Dim vba_col As Integer Dim last_row As Long Dim start As Double Dim finish As Double Dim total_time As Double Application.ScreenUpdating = False start = Timer ' remember time when macro starts. Set ws = Workbooks("lista_spolek_gpw.xlsm").Worksheets("MBank_Statsy") last_row = ws.Cells(Rows.Count, 1).End(xlUp).row row = 3 Set a_cell = ws.Range("A1:ZZ1").Find(What:="LOW", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Set b_cell = ws.Range("A1:ZZ1").Find(What:="CLOSE", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Set vba_cell = ws.Range("A1:ZZ1").Find(What:="VBA code" & Chr(10) & "result", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _ MatchCase:=True, SearchFormat:=False) b_col = b_cell.Column vba_col = vba_cell.Column ws.Cells(row, b_col).Activate With ws.Range("M3:N" & last_row) ' previous version: ws.Range("M2:N" & Rows.Count) .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .NumberFormat = "00.00%" .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .ColumnWidth = 13 End With With ws Do While Cells(row, b_col) <> "" current_price = ActiveCell.Value previous_price = ActiveCell.Offset(-1, 0).Value ws.Cells(row, vba_col) = Round(current_price / previous_price - 1, 4) ws.Cells(row, 14) = Log(current_price / previous_price) row = row + 1 ws.Cells(row, b_col).Activate Loop End With finish = Timer total_time = Round(finish - start, 3) ' Calculate total time. MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation Application.ScreenUpdating = True End Sub 

任何build议,这将使这个代码运行速度非常赞赏。 我只是VBA的初学者。

这是表格的样子 – 它的股票报价单。 计算使用“CLOSE”列中的值。

在这里输入图像说明 在这里输入图像说明

我构build了一个简化版本的代码,并获得了几乎相同的运行时。

接下来我更新了这个简化的版本来处理数组。 它快得多。 在这里输入图像说明

我的代码使用了一些硬编码的值,但是我的目标不是为你find解决scheme,而是得到一个可以帮助你自己编写代码的解决scheme。 希望能帮助到你。

 Sub Normal_Return_Rate_fast() Dim ws As Worksheet Dim last_row As Long Dim row As Long Dim b_col As Integer Dim arr As Variant Dim res() As Double Application.ScreenUpdating = False start = Timer Set ws = Workbooks("Book1.xlsm").Worksheets("Sheet1") last_row = ws.Cells(Rows.Count, 1).End(xlUp).row row = 2 b_col = 1 arr = Range("A2:A6000").Value size_x = last_row - row + 1 ReDim res(size_x, 2) As Double Dim i As Long For i = 2 To UBound(arr, 1) res(i - 2, 0) = Round(arr(i, 1) / arr(i - 1, 1) - 1, 4) res(i - 2, 1) = Log(arr(i, 1) / arr(i - 1, 1)) Next i Range("B3:C6000").Value = res finish = Timer total_time = Round(finish - start, 3) ' Calculate total time. MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation Application.ScreenUpdating = True End Sub 

这就是我的“TestWorkbook”的样子。

在这里输入图像说明

A栏只有1至5999