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＆amp;内存不足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

如果这样做（并检查它;容易出错），那么我们可以继续看看我们是否可以对它进行更优化。

VBA。 300mb +优化宏

1 个答案: