VBA excel，提高沒有循環的性能

我有兩個相同的工作表，我想要採取的行，在多個相同的列（工作表總是63列和504行和增加），我使用兩個for循環在一行中增加行，然後將另一行中的所有行與該行進行比較，然後再次增加行，並將另一行的行與該行等進行比較。直到最後一行，然後是if循環來查看它們是否符合我的條件。問題是它花費了太多時間（大約8分鐘），我試圖使用查找功能，但它失敗了，因爲它只能取一個值。我添加了錯誤的屏幕更新，計算和啓用事件，甚至將狀態欄更改爲非常基本的內容以提高性能，但沒有給出我想要的結果。VBA excel，提高沒有循環的性能

如何以任何可能的方式提高性能，新功能或其他？

PS有些時候某些條件並不重要，它取決於某些單元格上的真值或fasle值。

For Row_S = 2 To MAX_Row_S 
    SourceMonth = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, SOP).Value 
    SourceMonth = DatePart("m", SourceMonth) 
    SourceYear = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, SOP).Value 
    SourceYear = DatePart("yyyy", SourceYear) 
    SourceCarmaker = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, carmaker).Value 
    SourceProject = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Project).Value 
    SourceFamily = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Family).Value 
    SourceStatus = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Status).Value 
    SourceShare = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Share).Value 
    SourceCst = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, "A").Value 
    SourcePID = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, ProjectID).Value 

    ' Take the data from NBG_Data_Region sheet to be Compared with each row of the NBG_Data_Source_Region sheet 
    For Row_T = 2 To MAX_Row_T 
    If Row_T >= MAX_Row_T Then 
     Exit For 
    End If 

    NBGMonth = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, SOP).Value 
    NBGMonth = DatePart("m", NBGMonth) 
    NBGYear = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, SOP).Value 
    NBGYear = DatePart("yyyy", NBGYear) 
    NBGCarmaker = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, carmaker).Value 
    NBGProject = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Project).Value 
    NBGFamily = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Family).Value 
    NBGStatus = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Status).Value 
    NBGShare = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Share).Value 
    NBGCst = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, "A").Value 
    NBGPID = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value 

    ' StatusBar Show 
    Application.StatusBar = "Running" 
    'Application.StatusBar = "VerifyMultipleCustomerProjects. Progress: " & Row_S & " of " & MAX_Row_S 
    ' Check if any project in the NBG_Data_Region have multiple customers and add it ti the sheet Issue_MultipleCustomerProjects 

    ' NAF 20161208 

    'Test with Source of YEAR and MONTH 
    If ((NBGMonth = SourceMonth Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("C21") = True) And _ 
     (NBGYear = SourceYear Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("C25") = True) And _ 
     (SourceCarmaker = NBGCarmaker Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("G25") = True) And _ 
     (SourceProject = NBGProject Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("F25") = True) And _ 
     (SourceFamily = NBGFamily Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("E25") = True) And _ 
     (SourceShare + NBGShare <> 1 Or Worksheets(Issue_MultipleCustomerProjectsWorksheetName).Range("H25") = True) And NBGCst <> SourceCst) Then

來源

2017-01-18 Nasser Al Fanek

使用陣列的代替constently訪問片。將所有內容加載到兩個數組中，並將數據輸出到您將回發一次的另一個數組。這樣你只能訪問表單三次。它將運行時間縮短爲秒。 –

我會將數據加載到數組中。然後您可以在每個事務中從工作表中拉出兩組數據，然後在數組之間進行任何比較。就目前而言，你正在做大約280萬筆交易，這將解釋速度問題。 - @Scott Craner，同一時間張貼，但它是偉大的，你有完全相同的邏輯:) – Zerk

@ScottCraner謝謝你，陣列工作有點棘手，但我正在努力，祝我好運:) –

你有沒有嘗試添加

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.DisplayAlerts = False

在你的代碼的開頭，並

Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.DisplayAlerts = True

在你的代碼的結束？

這將關閉屏幕更新，事件和警報，從而加快運行時間。

另外，如果您決定採用該路線，加載和卸載陣列是最快的方法。

加載陣列的例子：

Dim arr() As Variant ' let brackets empty, not Dim arr(1) As Variant ! 

For Each a In Range.Cells 
    ' change/adjust the size of array 
    ReDim Preserve arr(1 To UBound(arr) + 1) As Variant 

    ' add value on the end of the array 
    arr(UBound(arr)) = a.Value 
Next

通過陣列迭代拉數據的一個例子：

For Each element In arr 'Each array element 
    do_something (element) 
Next element

來源

2017-01-18 16:53:23 Brad

我做了，但運行時間減少了幾秒鐘，請你說明加載和卸載數組？ –

@NasserAlFanek請看我更新的答案，因爲我提供了一個例子。 – Brad

非常感謝您的清除，我將開始使用陣列，謝謝。 –

VBA excel，提高沒有循環的性能

回答

相關問題