卡车计算

Question

如何提高VBA代码的运行速度？

我遇到的问题是For / Next命令需要大约10个小时来计算和打印所有数据。我无法进行计算，因为我需要为每个节点（check_nodes）计算出值。

我有1张纸（“评分”），它对所有check_trucks（38辆卡车）的每个check_node（944个节点）执行计算（25），因此将25 * 944 * 38 = 896800个数据点编译并打印到不同的位置38辆卡车中的每辆卡车的床单。我得到的结果和格式是正确的，我只需要以某种方式加速代码即可。

最初，我打算为所有38辆卡车单独运行VBA，但随后决定修改代码以自动运行所有卡车。不幸的是，这大大增加了运行时间。

Sub Perform_Rating_Check()

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
  StartTime = Timer

'------------------------
'DETERMINE NUMBER OF ROWS OF DATA FOR LOAD RATING SUMMARY
'------------------------

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False

    Sheets("Output").Activate
    Row = Range("Start.Nodes").Row
    Column = Range("Start.Nodes").Column

    startRow = Range("Start.Nodes").Row
    nrows = Range("Num_Checks").Value

    ReDim check_nodes(1 To nrows)
    For q = 1 To nrows
        check_nodes(q) = Cells(startRow - 1 + q, Column)
    Next

'------------------------------
'CALCULATE & PRINT LOAD RATINGS
'------------------------------

    ReDim PR_summary(1 To nrows, 1 To 26)

    Sheets("Rating").Activate
    Truck_row = Range("Start.Truck").Row
    Truck_col = Range("Start.Truck").Column

    ntrucks = Range("Num.Trucks").Value

    ReDim check_trucks(1 To ntrucks)
    For k = 1 To ntrucks
        check_trucks(k) = Cells(Truck_row - 1 + k, Truck_col)
    Next

    For j = 1 To ntrucks
        TruckSheet = check_trucks(j)
        Range("Choose.Truck") = check_trucks(j)
        Sheets(TruckSheet).Activate
             For s = 1 To nrows
                Range("Check_Location") = check_nodes(s)
                PR_row = Range("A9").Row - 1
                PR_col = Range("A9").Column - 1
                Cells(PR_row + s, PR_col + 1) = check_nodes(s)
                Cells(PR_row + s, 2) = Range("RF_INV_Axial").Value
                Cells(PR_row + s, 3) = Range("RF_INV_Major").Value
                Cells(PR_row + s, 4) = Range("RF_INV_Minor").Value
                Cells(PR_row + s, 5) = Range("RF_OPR_Axial").Value
                Cells(PR_row + s, 6) = Range("RF_OPR_Major").Value
                Cells(PR_row + s, 7) = Range("RF_OPR_Minor").Value
                Cells(PR_row + s, 8) = Range("RF_INV_Axial_My").Value
                Cells(PR_row + s, 9) = Range("RF_INV_Major_My").Value
                Cells(PR_row + s, 10) = Range("RF_INV_Minor_My").Value
                Cells(PR_row + s, 11) = Range("RF_OPR_Axial_My").Value
                Cells(PR_row + s, 12) = Range("RF_OPR_Major_My").Value
                Cells(PR_row + s, 13) = Range("RF_OPR_Minor_My").Value
                Cells(PR_row + s, 14) = Range("RF_INV_Axial_Mz").Value
                Cells(PR_row + s, 15) = Range("RF_INV_Major_Mz").Value
                Cells(PR_row + s, 16) = Range("RF_INV_Minor_Mz").Value
                Cells(PR_row + s, 17) = Range("RF_OPR_Axial_Mz").Value
                Cells(PR_row + s, 18) = Range("RF_OPR_Major_Mz").Value
                Cells(PR_row + s, 19) = Range("RF_OPR_Minor_Mz").Value
                Cells(PR_row + s, 20) = Range("RF_INV_Shear_P").Value
                Cells(PR_row + s, 21) = Range("RF_INV_Shear_My").Value
                Cells(PR_row + s, 22) = Range("RF_INV_Shear_Mz").Value
                Cells(PR_row + s, 23) = Range("RF_OPR_Shear_P").Value
                Cells(PR_row + s, 24) = Range("RF_OPR_Shear_My").Value
                Cells(PR_row + s, 25) = Range("RF_OPR_Shear_Mz").Value
            Next s
    Next j

'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True

End Sub

我喜欢当前如何打印数据，但我只是希望它运行得更快。上一次我运行代码大约花了10个小时。