VBA excel，无循环提高性能

Question

我有两张相同的工作表，我想获取其中的行，它们在多列中是相同的（工作表总是 63 列和 504 行并且还在增加），我正在使用两个 for 循环来增加一行和然后将另一行中的所有行与该行进行比较，然后再次增加该行并将另一行的所有行与该行等进行比较。直到最后一行，然后是一个 if 循环，看看它们是否符合我的条件。问题是它花费了太多时间（大约 8 分钟），我尝试使用查找功能但它失败了，因为它只能取一个值。我添加了错误的屏幕更新、计算和启用事件，甚至将状态栏更改为非常基本的东西以提高性能，但它们都没有给我想要的结果。

我怎样才能以任何可能的方式提高性能，新功能或任何东西？？

PS 有时某些条件并不重要，它取决于某些单元格上的真值或假值。

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

Answer 1

你有没有尝试添加

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