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 

如果工作正常（和检查;错误。易制），那么我们可以去看看，如果我们能够优化多一点。