VBA卓越，提高性能没有循环
我有两个相同的工作表，我想采取的行，是相同的多个列（工作表总是63列和504行和增加），我使用两个for循环增加一个行，然后比较所有另一行中的行再次增加行，并将另一行的所有行与该行等进行比较。 直到最后一行，然后if循环，看看它们是否符合我的条件。 问题是，它花费了太多的时间（大约8分钟），我试图使用查找function，但它失败了，因为它只能采取一个值。 我添加了错误的屏幕更新，计算和enableevents，甚至改变状态栏为非常基本的东西，以提高性能，但他们没有给我我想要的结果。
我怎样才能以任何方式提高性能，一个新的function或任何东西？
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 你试过添加吗？
Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False
在你的代码的开始处，
Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True
在你的代码结束？
这将closures屏幕更新，事件和警报，导致更快的运行时间。
另外，如果你决定采用这种方式，加载和卸载数组是最快的方法。
加载数组的一个例子：
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