優化excel數組

Question

我有一個非常大的數據集（600,000行）的數據結構如下格式：

1）有大約60個產品。一個是美國總數，另一個是製造商，並標註爲KMF。也有一些標註爲PCKGs（但不相關的這個問題）

2）每個產品位於60周不同的市場

3）每個市場都有20米不同的地點

4）我有12個指標，我需要按以下方式計算數據：每個指標的美國總數 - 總和（KMF）

我已經爲此編寫了vba代碼，但運行時間太長（大約20分鐘）我需要在至少20個工作表上運行類似的代碼。我嘗試了各種方法，如將screenUpdating等設置爲false。這是我的代碼。我是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

Answer 1

我認爲這會工作（雖然我還沒有機會測試它），應該是很多速度快：

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(..)的快捷方式，而活動*屬性本質上很慢並且不可靠，因爲它們可以在代碼運行時更改。更糟糕的是，這個代碼是，假設那ActiveSheet = Energy_LS_Blotter這是遠遠不確定的。

寫這條線會是這樣的正確方法：

data = ActiveWorkbook.Sheets(Sheet).Range(_ 
      ActiveWorkbook.Sheets(Sheet).Cells(1, 1), _ 
      ActiveWorkbook.Sheets(Sheet).Cells(LastRow, LastCol) _ 
      ).Value 

但是，這是漫長的，難看又不方便。更簡單的方法是使用一個表變量或With：

With ActiveWorkbook.Sheets(Sheet) 
    data = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).Value 
End With