Повышение эффективности в фоновом режиме журнала

Question

Я создал подпрограмму журнала, которая создает модуль в нужном файле, который записывает все изменения для будущего аудита на основе событий рабочей книги.Я хотел бы предложить альтернативу, которую я могу активировать в начале длинного процесса подпрограмм, применяемых к 100 000 строк, который, по-видимому, моя не поддерживает.

Моя подпрограмма журнала, кажется, работает нормально, когда активирована на чистом листе, однако она не может записать все изменения, сделанные моей серией soubroutines.Так как он отслеживает изменение каждой отдельной ячейки в значении, и в 100 000 строк происходит ряд изменений, это приводит к сбою приложения.Я пытался придумать, как адаптировать его, чтобы он был более эффективным для моего использования, но до сих пор я был не в себе.

Ниже приведен код, который я импортирую в обработанный файл для отслеживанияизменений.При необходимости я также могу опубликовать подпрограмму, которая ее импортирует.

public strOldAddress As String
Private Sub Worksheet_Change(ByVal Target As Range)    
Dim rngSubTarget As Range
Dim lngBothCounter As Long
Dim Post() As String

'\ Parameters to register changes
Dim wsLog As Worksheet
Dim lngLogInputRow As Long
Set wsLog = ThisWorkbook.Sheets("Log")


'\ Detect changes in value
lngBothCounter = 1
ReDim Post(1 To Target.Cells.Count)
For Each rngSubTarget In Target.Cells
    '\ Error Handler for changed values
    If IsError(rngSubTarget.Value) Then
        Post(lngBothCounter) = "ERROR"
    Else
        Post(lngBothCounter) = rngSubTarget.Value
    End If
    '\ Debug.Print for each value Ante and Post
    'Debug.Print Post(lngBothCounter); " e " & Ante(lngBothCounter)
    '\ Add changes values to log
    If Ante(lngBothCounter) <> Post(lngBothCounter) Then
        rngSubTarget.Interior.ColorIndex = 37
        lngLogInputRow = wsLog.Range("A" & Rows.Count).End(xlUp).Row + 1
        wsLog.Cells(lngLogInputRow, 1).Value = wsLog.Cells(lngLogInputRow, 1).Row - 1
        wsLog.Cells(lngLogInputRow, 2).Value = Ante(lngBothCounter)
        wsLog.Cells(lngLogInputRow, 3).Value = Post(lngBothCounter)
        wsLog.Cells(lngLogInputRow, 4).Value = " " & rngSubTarget.Formula
        wsLog.Hyperlinks.Add anchor:=wsLog.Cells(lngLogInputRow, 5), Address:="", _
            SubAddress:="'" & ThisWorkbook.Sheets(1).Name & "'!" & rngSubTarget.Address, TextToDisplay:=rngSubTarget.Address
        wsLog.Hyperlinks.Add anchor:=wsLog.Cells(lngLogInputRow, 6), Address:="", _
            SubAddress:="'" & ThisWorkbook.Sheets(1).Name & "'!" & strOldAddress, TextToDisplay:=strOldAddress
        wsLog.Cells(lngLogInputRow, 7).Value = Environ("username")
        wsLog.Cells(lngLogInputRow, 8).Value = Now

    End If
    lngBothCounter = lngBothCounter + 1
Next rngSubTarget

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rngSubTarget As Range
Dim lngAnteCounter As Long

lngAnteCounter = 1
ReDim Ante(1 To Target.Cells.Count)
For Each rngSubTarget In Target.Cells
    '\ Error Handling for values in selection
    If IsError(rngSubTarget.Value) Then
        Ante(lngAnteCounter) = "ERROR"
    Else
        Ante(lngAnteCounter) = rngSubTarget.Value
    End If
    lngAnteCounter = lngAnteCounter + 1
Next rngSubTarget

strOldAddress = Target.Address

End Sub

Я ожидал, что она отследит все изменения, но когда через макрос выполняется слишком много изменений, происходит сбой приложения (файл журналапусто, пока я не попытаюсь сохранить файл, когда он вылетает).