нормальный лог файла LOG

Опубликовано автор kos20 
'---------------------------------------------------------------------------------------
' Module    : ЭтаКнига
' DateTime  : 12.08.2014 16:57
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             http://www.excel-vba.ru
' Purpose   : http://www.excel-vba.ru/chto-umeet-excel/vedenie-zhurnala-sdelannyx-v-knige-izmenenij/
'---------------------------------------------------------------------------------------
'Option Explicit
Public sValue As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "LOG" Then Exit Sub
    Dim sLastValue As String
    Dim lLastRow As Long
 
    With Sheets("LOG")
        lLastRow = .Cells.SpecialCells(xlLastCell).Row + 1
        If lLastRow = Rows.Count Then Exit Sub
        Application.ScreenUpdating = False: Application.EnableEvents = False
        .Cells(lLastRow, 1) = CreateObject("wscript.network").UserName
        .Cells(lLastRow, 2) = Target.Address(0, 0)
        .Cells(lLastRow, 3) = Format(Now, "dd.mm.yyyy")
        .Cells(lLastRow, 4) = Sh.Name
        .Cells(lLastRow, 5).NumberFormat = "@"
        .Cells(lLastRow, 5) = sValue
        If Target.Count > 1 Then
            Dim rCell As Range, rRng As Range
            On Error Resume Next
            Set rRng = Intersect(Target, Sh.UsedRange): On Error GoTo 0
            If Not rRng Is Nothing Then
                For Each rCell In rRng
                    If Not IsError(Target) Then sLastValue = sLastValue & "," & rCell Else sLastValue = sLastValue & "," & "Err"
                Next rCell
                sLastValue = Mid(sLastValue, 2)
            Else
                sLastValue = ""
            End If
        Else
            If Not IsError(Target) Then sLastValue = Target.Value Else sLastValue = "Err"
        End If
        .Cells(lLastRow, 6).NumberFormat = "@"
        .Cells(lLastRow, 6) = sLastValue
    End With
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "LOG" Then Exit Sub
    If Target.Count > 1 Then
        Dim rCell As Range, rRng As Range
        On Error Resume Next
        Set rRng = Intersect(Target, Sh.UsedRange): On Error GoTo 0
        If rRng Is Nothing Then Exit Sub
 
        txt = Split(Target.Address, "$")(1)
        nbr = Mid(Split(Target.Address, "$")(2), 1, Len(Split(Target.Address, "$")(2)) - 1)
'        For Each rCell In rRng
'            If Not IsError(rCell) Then sValue = sValue & "," & rCell Else sValue = sValue & "," & "Err"
'        Next rCell
        sValue = Range("" & txt & nbr & "").Value
        sValue = sValue 'Mid(sValue, 2)
    Else
        If Not IsError(Target) Then sValue = Target.Value Else sValue = "Err"
    End If
End Sub