Я унаследовал книгу Excel со следующим VBA-кодом.Рабочая книга содержит соединения SAP Analysis для Excel.Изменяемый лист «Согласование» содержит приблизительно 15000 строк.А в столбце «А» хранится множество чисел, хранящихся в виде текста (в углу ячейки отображаются зеленые метки).
Код пересекает данные и многократно циклически переходит по строкам данных назад и вперед.
Моя проблема в том, что использование памяти приложением Excel быстро увеличивается при запуске этого сабвуфера.И в какой-то момент произойдет сбой Excel и не хватит памяти.
Я обнаружил утечки памяти VBA и попытался изменить следующее:
- Изменение
Range("A" & i) на Cells(i, "A") - Добавлен
.Value ко всем ссылкам на значения ячеек - Добавлен объект рабочей книги ко всем
Range и Cells ссылкам (MyWorkbook.Range("A" & i).Value) - Перемещены определения переменных всамый внутренний возможный уровень вместо начала подпрограммы (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