Vba。 300MB +優化宏觀

Question

（還有更多的代碼之後/下面的代碼之前，這部分是我想優化環路）

Sheets("LeanReport").Activate 

Dim lRow As Long 
On Error Resume Next 
lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0) 
On Error GoTo 0 
If lRow > 0 Then 
    'code 
End If 

For i = 2 To LastrowLeanReport 
    R1 = CStr(Cells(i, 5)) 
    RG1 = CStr(Cells(i, 24)) 

    MatrizRG1(i - 2) = RG1 
    MatrizR1(i - 2) = R1 
Next i 

Sheets("Carrier").Activate 

For i = 2 To LastrowCarrier 
    RG2 = CStr(Cells(i, 1)) 
    MatrizRG2(i - 2) = RG2 
Next i 

For j = 2 To LastrowCarrier 
    For p = lRow To LastrowLeanReport 
     If MatrizRG2(j) = MatrizRG1(p) Then 
      MatrizRG3(j) = Cells(j, 1) 
      MatrizC1(j) = MatrizR1(p) 
     End If 
    Next p 
    If MatrizRG3(j) = "" Then 
     For x = 0 To lRow 
      If MatrizRG2(j) = MatrizRG1(x) Then 
       MatrizRG3(j) = Cells(j, 1) 
       MatrizC1(j) = MatrizR1(p) 
      End If 
     Next x 
    End If 
Next j 

有什麼辦法來優化這個宏？ Lastrowleanreport有超過700000行我如何改變這些循環的其他東西？

它給我所有的時間錯誤6 & 7內存不足。

Answer 1

代替將數據加載到矩陣中，然後在矩陣上操作，您可以直接在單元上操作。然後你不消耗大矩陣的內存。

爲了達到這個目的，我第一次改變了你的代碼，所以我可以找到等價的表達式。例如，你將一些東西分配給一個矩陣元素，然後使用這個元素。那麼這個用法就相當於從表單中獲取數據並放入矩陣元素中的表達式。

一旦完成，您可以將上次for循環中的矩陣引用替換爲單元格引用。在這裏我看到一些有趣的東西：你的源工作表顯然有2個標題行，你可以跳過。但之後在for循環中再次跳過它們，但現在您也跳過前兩個矩陣元素！我不認爲這是你的意思：

For j = 0 To LastrowCarrier - 2 
    For p = lRow To LastrowLeanReport 
     If MatrizRG2(j + 2) = MatrizRG1(p) Then 
      MatrizRG3(j + 2) = Cells(j + 2, 1) 
      MatrizC1(j + 2) = MatrizR1(p) 
     End If 
    Next p 
    If MatrizRG3(j + 2) = "" Then 
     For x = 0 To lRow 
      If MatrizRG2(j + 2) = MatrizRG1(x) Then 
       MatrizRG3(j + 2) = Cells(j + 2, 1) 
       MatrizC1(j + 2) = MatrizR1(p) 
      End If 
     Next x 
    End If 
Next j 

在上面，我認爲表達j + 2應該只是j（除Cells表達）。我繼續在那裏。還請注意p在MatrizR1(p)是不明確的，因爲它指向矩陣之外（我把這個錯誤留給你修復）。

接下來我介紹了工作表的變量，所以更容易解決它們。我改變了循環開始從零到行數 - 2.本提供了以下相當於子程序：

Dim sheetCarrier As Worksheet 
Dim sheetReport As Worksheet 
Dim lRow As Long 

Set sheetReport = Sheets("LeanReport") 
sheetReport.Activate 
lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0) 

For i = 0 To LastrowLeanReport - 2 
    MatrizRG1(i) = CStr(sheetReport.Cells(i + 2, 24)) 
    MatrizR1(i) = CStr(sheetReport.Cells(i + 2, 5)) 
Next i 

Set sheetCarrier = Sheets("Carrier") 

For i = 0 To LastrowCarrier - 2 
    MatrizRG2(i) = CStr(sheetCarrier.Cells(i + 2, 1)) 
Next i 

For i = 0 To LastrowCarrier - 2 
    For p = lRow To LastrowLeanReport 
     If MatrizRG2(i) = MatrizRG1(p) Then 
      MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1) 
      MatrizC1(i) = MatrizR1(p) 
     End If 
    Next p 
    If MatrizRG3(i) = "" Then 
     For x = 0 To lRow 
      If MatrizRG2(i) = MatrizRG1(x) Then 
       MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1) 
       MatrizC1(i) = MatrizR1(p) 
      End If 
     Next x 
    End If 
Next I 

在接下來的步驟，我現在只有在單元格中的最後一個循環，以取代矩陣引用來自早期循環的參考。這些等同是：

MatrizRG1(i) = CStr(sheetReport.Cells(i + 2, 24)) 
MatrizR1(i) = CStr(sheetReport.Cells(i + 2, 5)) 
MatrizRG2(i) = CStr(sheetCarrier.Cells(i + 2, 1)) 

（我不知道你在MatrizRG3和MatrizC1輸出是怎麼回事，所以我離開，在代碼 - 漂亮的練習。）

沒有矩陣等價的子程序就變成了：

Dim sheetCarrier As Worksheet 
Dim sheetReport As Worksheet 
Dim lRow As Long 

Set sheetCarrier = Sheets("Carrier") 
Set sheetReport = Sheets("LeanReport") 
sheetReport.Activate 
lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0) 

For i = 0 To LastrowCarrier - 2 
    For p = lRow To LastrowLeanReport 
     If CStr(sheetCarrier.Cells(i + 2, 1)) = CStr(sheetReport.Cells(p + 2, 5)) Then 
      MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1) 
      MatrizC1(i) = CStr(sheetReport.Cells(p + 2, 5)) 
     End If 
    Next p 
    If MatrizRG3(i) = "" Then 
     For x = 0 To lRow 
      If CStr(sheetCarrier.Cells(i + 2, 1)) = CStr(sheetReport.Cells(x + 2, 24)) Then 
       MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1) 
       MatrizC1(i) = CStr(sheetReport.Cells(p + 2, 5)) ' note: this 'p' is undefined!! 
      End If 
     Next x 
    End If 
Next i 

如果工作正常（和檢查;錯誤。易制），那麼我們可以去看看，如果我們能夠優化多一點。