我正在嘗試創建一個宏,為資料集的特定行為分配機動名稱(加速、平緩巡航、減速)。我決定將大型資料集劃分為包含 5 個單元格的子集,并且代碼正在檢查其行為(值是變小還是變大)。
.csv 檔案包含或多或少的 20k 行,代碼迭代它 5 分鐘。我可以讓它更快一點嗎?
外部 for 回圈將資料集劃分為包含 5 個單元格的子集。慢速迭代器操縱這些值。
然后它只是根據單元格中的值減少或增加來分配值
Sub maneuverSet(lu As Worksheet, nr As Long)
lu.Activate
Dim fast_ite As Long, slow_ite As Integer, numRows As Long
Dim slow_1 As Long, slow_2 As Long, slow_3 As Long, slow_4 As Long, slow_5
numRows = nr 'definition in main: numRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
Application.ScreenUpdating = False
For fast_ite = 4 To numRows Step 5
Dim ite_array As Variant
slow_1 = fast_ite - 2
slow_2 = fast_ite - 1
slow_3 = fast_ite
slow_4 = fast_ite 1
slow_5 = fast_ite 2
ite_array = Array(slow_1, slow_2, slow_3, slow_4, slow_5)
' Now it just checks if the cell consist the values that ramping up with each row or not.
If Cells(slow_1, "A") < Cells(slow_2, "A") And Cells(slow_1, "A") < Cells(slow_2, "A") And Cells(slow_2, "A") < Cells(slow_3, "A") _
And Cells(slow_3, "A") < Cells(slow_4, "A") And Cells(slow_4, "A") < Cells(slow_5, "A") Then
For Each iterator In ite_array
Cells(iterator, "AB") = "RampUp"
Next
ElseIf Cells(slow_1, "A") > Cells(slow_2, "A") And Cells(slow_1, "A") > Cells(slow_2, "A") And Cells(slow_2, "A") > Cells(slow_3, "A") _
And Cells(slow_3, "A") > Cells(slow_4, "A") And Cells(slow_4, "A") > Cells(slow_5, "A") Then
For Each iterator In ite_array
Cells(iterator, "AB") = "RampDown"
Next
Else
For Each iterator In ite_array
Cells(iterator, "AB") = "Cruise"
Next
End If
Next
Application.ScreenUpdating = True
End Sub
uj5u.com熱心網友回復:
讀/寫到/從單元格通常是一個非常緩慢的操作,因此您將希望盡可能避免這種情況。
相反,將值存盤到陣列中,然后通過陣列處理邏輯。
在不改變太多邏輯的情況下,這可能是陣列方法的樣子:
Sub maneuverSet(lu As Worksheet, nr As Long)
lu.Activate
Dim fast_ite As Long, numRows As Long
numRows = nr 'definition in main: numRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
Application.ScreenUpdating = False
For fast_ite = 4 To numRows Step 5
'Assign the 5 values into an array for processing
Dim dataArr As Variant
dataArr = lu.Cells(fast_ite, "A").Offset(-2).Resize(5).Value
Dim outcome As String 'used to store the outcome of this loop
If dataArr(1, 1) < dataArr(2, 1) And _
dataArr(2, 1) < dataArr(3, 1) And _
dataArr(3, 1) < dataArr(4, 1) And _
dataArr(4, 1) < dataArr(5, 1) Then
outcome = "RampUp"
ElseIf dataArr(1, 1) > dataArr(2, 1) And _
dataArr(2, 1) > dataArr(3, 1) And _
dataArr(3, 1) > dataArr(4, 1) And _
dataArr(4, 1) > dataArr(5, 1) Then
outcome = "RampDown"
Else
outcome = "Cruise"
End If
'Write the outcome into the 5 cells at once.
lu.Cells(fast_ite, "AB").Offset(-2).Resize(5).Value = outcome
Next
Application.ScreenUpdating = True
End Sub
下面應該更快,因為它只讀取和寫入單元兩次:
Sub maneuverSet(lu As Worksheet, nr As Long)
lu.Activate
Application.ScreenUpdating = False
'Read the entire data into an array
Dim dataArr As Variant
dataArr = lu.Range("A2:A" & nr).Value
'Create another array of the same size to store the outcome (to be written into column AB)
Dim outputArr() As String
ReDim outputArr(1 To UBound(dataArr, 1), 1 To 1) As String
'Loop through the array as per your logic
Dim i As Long
For i = 1 To UBound(dataArr, 1) Step 5
Dim outcome As String
If dataArr(i, 1) < dataArr(i 1, 1) And _
dataArr(i 1, 1) < dataArr(i 2, 1) And _
dataArr(i 2, 1) < dataArr(i 3, 1) And _
dataArr(i 3, 1) < dataArr(i 4, 1) Then
outcome = "RampUp"
ElseIf dataArr(i, 1) > dataArr(i 1, 1) And _
dataArr(i 1, 1) > dataArr(i 2, 1) And _
dataArr(i 2, 1) > dataArr(i 3, 1) And _
dataArr(i 3, 1) > dataArr(i 4, 1) Then
outcome = "RampDown"
Else
outcome = "Cruise"
End If
Dim n As Long
For n = i To i 4
outputArr(n, 1) = outcome
Next n
Next i
'Write the entire outcome array into the worksheet
lu.Range("AB2:AB" & nr).Value = outputArr
Application.ScreenUpdating = True
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/qiye/428143.html
下一篇:重組何時發生?改變狀態或改變輸入
