excel - Excel sub 中的内存管理/泄漏，有几个直到循环

问题描述

我继承了具有以下 VBA 代码的 Excel 工作簿。该工作簿包含 SAP Analysis for Excel 连接。它正在更改的“对帐”工作表包含大约 15000 行。在“A”列中，我们有很多以文本形式存储的数字（它在单元格的角落显示绿色标记）。

代码遍历数据并在数据行中反复循环。

我的问题是，运行此子程序时 Excel 应用程序的内存使用量会迅速增加。在某些时候，它会使 Excel 崩溃并耗尽内存。

我用谷歌搜索了 VBA 内存泄漏并尝试更改以下内容：

更改Range("A" & i)为Cells(i, "A")
添加.Value到所有单元格值引用
Range向所有和Cells引用添加了一个工作簿对象( MyWorkbook.Range("A" & i).Value)
将变量定义移动到可能的最内层，而不是在 sub (j, r, c) 的开头

这些都对内存消耗没有任何影响。

如果我将“和解”表移动到一个新的工作簿并在那里复制子，则子几乎立即运行并完成，而内存使用量没有任何明显增加。

因此，这表明代码实际上是可以的。

但我会很感激有关代码中的内存繁重操作的任何建议？

Sub Reconciliation02()

Dim i As Long
Dim Resultatet As String
Dim MyWorksheet As Worksheet
Dim LastRow As Long

'Application.Calculation = xlManual
Application.ScreenUpdating = False

'ThisWorkbook.Sheets("Reconciliation").Select
Set MyWorksheet = ThisWorkbook.Sheets("Reconciliation")
'ActiveSheet.Range("A2").Select

i = 2
'LastRow = MyWorksheet.Cells(Rows.Count, 1).End(xlUp).Row

'Do While i <= LastRow
Do Until MyWorksheet.Cells(i, "A").Value = ""
'Do Until MyWorksheet.Range("A" & i).Value = ""

    If Mid(MyWorksheet.Range("B" & i), 3, 1) = "/" Then
        MyWorksheet.Range("B" & i).Value = Right(MyWorksheet.Range("B" & i), Len(MyWorksheet.Range("B" & i).Value) - 3)
    End If

    If (MyWorksheet.Range("E" & i).Value <> "" And Right(MyWorksheet.Range("E" & i).Value, 1) <> "#") Then
        With MyWorksheet.Range("E" & i).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If

    If (MyWorksheet.Range("H" & i).Value <> "" And Right(MyWorksheet.Range("H" & i).Value, 1) <> "#") Then
        With MyWorksheet.Range("H" & i).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If

    MyWorksheet.Cells(i, "W").Value = 1

    If MyWorksheet.Range("A" & i).Value = "#" Then
        MyWorksheet.Range("W" & i).Value = 1
    End If


    If (MyWorksheet.Range("B" & i).Value = "Result" And MyWorksheet.Range("A" & i).Value <> "#" And MyWorksheet.Range("S" & i).Value = 0) Then
        Dim j As Long
        Dim r As Long
        Dim c As Long

    '    'j = 0
    '    'r = 0
    '    'c = 0

        'Sætter "OK" hvis Result lig med 0
        MyWorksheet.Range("V" & i).Value = "OK"
        j = i - 1
        Do Until MyWorksheet.Range("A" & j).Value <> MyWorksheet.Range("A" & i).Value
            MyWorksheet.Range("V" & j).Value = "OK"
            j = j - 1
        Loop

        'tæller antal record per Reference
        c = j + 1
        Do Until c = i + 1
            MyWorksheet.Range("W" & c).Value = i - j
            c = c + 1
        Loop

        'Fjerner "OK" hvhis valuta ikke er ens på alle Reference linjer
        r = j
        Resultatet = "OK"
        Do Until r = i
            If (MyWorksheet.Range("Q" & r + 1).Value <> MyWorksheet.Range("Q" & r + 2).Value And r < i - 2) Then
                Resultatet = ""
                Do Until j = i
                    MyWorksheet.Range("V" & j + 1).Value = Resultatet
                    j = j + 1
                Loop
                r = i 'Vi need to exit the loop
            Else
                r = r + 1 'We need to carry on looping
            End If
        Loop

    End If 'Slut på total sum lig 0

    If (Range("B" & i) = "Result" And Range("A" & i) <> "#" And Range("S" & i) <> 0) Then
        j = i - 1
        Do Until Range("A" & j) <> Range("A" & i)
            j = j - 1
        Loop
        c = j + 1
        Do Until c = i + 1
            Range("W" & c).Value = i - j
            c = c + 1
        Loop

    End If
    i = i + 1
Loop

Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic

MsgBox ("Færdig med punkt 2")

Set MyWorksheet = Nothing

End Sub

标签： excelvbamemory-managementmemory-leaks

excel - Excel sub 中的内存管理/泄漏，有几个直到循环

问题描述

解决方案

推荐阅读