Question

我创建了一个日志例程，该例程在所需的文件中创建一个模块，该模块记录所有更改，以供将来基于工作簿事件进行审核。我想提出一个替代方案，该方案可以在应用到100.000行的漫长例程的开始时激活，而我的例程似乎无法支持。

在空白工作表中激活后，我的日志例程似乎可以正常工作，但是无法记录我的一系列例程所进行的所有更改。由于它跟踪每个单元格的值更改，并且在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

我希望它能够跟踪所有更改，但是当通过宏进行太多修改时，它会使应用程序崩溃（日志文件为空白，直到崩溃之前我尝试保存该文件）。

提高后台日志例程的效率

0 个答案: