优化Excel数组
我有一个非常大的数据集（60万行）的数据结构如下格式：
1）有大约60个产品。 一个是美国总数，另外一个是制造商，标注为KMF。 也有一些标签为PCKGs（但与这个问题不相关）
2）每个产品分布在60个不同的市场
3）每个市场有20个不同的地点
4）我有12个指标，我需要按以下方式计算数据：每个指标的总美金数量总和（KMF）
我已经为此写了vba代码，但运行时间太长（大约20分钟），我需要在至less20个工作表上运行类似的代码。 我已经尝试了各种方法，如设置screenUpdating等虚假。 这是我的代码。 我是vba编码的新手，所以我可能会漏掉一些明显的东西。 请让我知道任何不清楚。 请帮忙！
Sub beforeRunningCode() Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False End Sub Sub returnToOriginal() Application.ScreenUpdating = screenUpdateState Application.DisplayStatusBar = statusBarState Application.Calculation = calcState Application.EnableEvents = eventsState ActiveSheet.DisplayPageBreaks = displayPageBreaksState End Sub Function LastRowFunc(Sheet) As Long LastRowFunc = ActiveWorkbook.Worksheets(Sheet).Range("A2", Worksheets(Sheet).Range("A2").End(xlDown)).Rows.Count End Function Function LastColFunc(Sheet) As Long With ActiveSheet LastColFunc = ActiveWorkbook.Sheets(Sheet).Cells(1, .Columns.Count).End(xlToLeft).Column End With End Function Sub AOCalculate() Call beforeRunningCode 'Optimize Excel Dim LastRow As Long Dim LastCol As Long Dim Period As String Dim Sheet As String Dim Arr(1 To 16) Dim Count As Integer Sheet = "Energy_LS_Bottler" Period = "2016 WAVE 1 - 3 W/E 05/07" LastRow = LastRowFunc(Sheet) 'Calculate last row for which data exists LastCol = LastColFunc(Sheet) 'Calculate last column for which data exists For Each Location In ActiveWorkbook.Sheets("Locations").Range("D7:D28").Value For Each Market In ActiveWorkbook.Sheets("Markets").Range("A5:A92").Value Count = Count + 1 Arr(1) = Market Arr(2) = "AO" Arr(3) = Location Arr(4) = Period With ActiveWorkbook.Sheets(Sheet) 'Filtering for KMF .AutoFilterMode = False .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=17, Criteria1:="=KMF" .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=1, Criteria1:=Market .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=3, Criteria1:=Location End With For k = 5 To 16 Arr(k) = Application.WorksheetFunction.Sum(ActiveWorkbook.Sheets(Sheet).Range(Cells(1, k), Cells(LastRow, k)).SpecialCells(xlCellTypeVisible)) Next k With ActiveWorkbook.Sheets(Sheet) ' filtering for Total US .AutoFilterMode = False .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=17, Criteria1:="=Total US" .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=1, Criteria1:=Market .Range(Cells(1, 1), Cells(LastRow, LastCol)).AutoFilter field:=3, Criteria1:=Location End With For k = 5 To 16 Arr(k) = -Arr(k) + Application.WorksheetFunction.Sum(ActiveWorkbook.Sheets(Sheet).Range(Cells(1, k), Cells(LastRow, k)).SpecialCells(xlCellTypeVisible)) Next k For j = 1 To 16 ActiveWorkbook.Sheets(Sheet).Cells(LastRow + Count, j).Value = Arr(j) Next j Erase Arr Next Next ActiveWorkbook.Sheets(Sheet).AutoFilterMode = False Call returnToOriginal End Sub [编辑]：这里是一个示例数据集的链接https://drive.google.com/file/d/0B3MkGa57h6g_WGl2WWlWekd4NU0/view?usp=sharing
我认为这会起作用（虽然我没有机会去testing它），而且应该快很多：
Sub AOCalculate() Call beforeRunningCode 'Optimize Excel Dim LastRow As Long Dim LastCol As Long Dim Period As String Dim Sheet As String Dim Arr() '1 To 2000, 1 To 16) Dim Count As Integer Sheet = "Energy_LS_Bottler" Period = "2016 WAVE 1 - 3 W/E 05/07" LastRow = LastRowFunc(Sheet) 'Calculate last row for which data exists LastCol = LastColFunc(Sheet) 'Calculate last column for which data exists 'copy all of the relevant cells to local arrays for speed Dim Locations(), Markets(), data() Markets = ActiveWorkbook.Sheets("Markets").Range("A5:A92").Value Locations = ActiveWorkbook.Sheets("Locations").Range("D7:D28").Value '(pretty sure the following line needs to localize the Cells() to .Cells()) data = ActiveWorkbook.Sheets(Sheet).Range(Cells(1, 1), Cells(LastRow, LastCol)).Value '**' ReDim Arr(1 To UBound(Markets, 1) * UBound(Locations, 1), 16) 'make an index of pointers into our accumulation array Dim counts As New Collection Dim i As Long, l As Long, m As Long For l = 1 To UBound(Locations, 1) Location = Locations(l, 1) '**' For m = 1 To UBound(Markets, 1) Market = Markets(m, 1) '**' i = i + 1 counts.Add i, CStr(Location) & "~" & CStr(Market) 'counts.Add NewAccumArray(Location, Market, Period), CStr(Location) & "~" & CStr(Market) Arr(i, 1) = Market Arr(i, 2) = "AO" Arr(i, 3) = Location Arr(i, 4) = Period Next Next ' go through each row and add it to the appropiate count in the array Dim r As Long Dim key As String, idx As Long For r = 1 To UBound(data, 1) key = CStr(data(r, 3)) & "~" & CStr(data(r, 1)) If data(r, 17) = "KMF" Then idx = counts(key) For k = 5 To 16 Arr(idx, k) = Arr(idx, k) - data(r, k) Next k Else If data(r, 17) = "Total US" Then idx = counts(key) For k = 5 To 16 Arr(idx, k) = Arr(idx, k) + data(r, k) Next k End If End If Next r ' output the results ActiveWorkbook.Sheets(Sheet).Range(Cells(LastRow + 1, 1), Cells(LastRow + Count, 16)).Value = Arr ActiveWorkbook.Sheets(Sheet).AutoFilterMode = False Call returnToOriginal End Sub
回答“我的意思是什么？”
'(pretty sure the following line needs to localize the Cells() to .Cells()) data = ActiveWorkbook.Sheets(Sheet).Range(Cells(1, 1), Cells(LastRow, LastCol)).Value '**'
Cells(..)在这里的使用基本上是不可靠的，也是破碎的。 这是因为Cells(..)实际上是ActiveSheet.Cells(..)一个快捷方式，而Active *属性本质上很慢且不可靠，因为它们可以在代码运行时更改 。 更糟的是，这段代码假定 ActiveSheet = Energy_LS_Blotter ，这是远远不能确定的。
写这行的正确方法是这样的：
data = ActiveWorkbook.Sheets(Sheet).Range( _ ActiveWorkbook.Sheets(Sheet).Cells(1, 1), _ ActiveWorkbook.Sheets(Sheet).Cells(LastRow, LastCol) _ ).Value
但那是漫长的，丑陋的和不方便的。 更简单的方法是使用Sheetvariables或With ：
With ActiveWorkbook.Sheets(Sheet) data = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).Value End With