Есть такой макрос, он делает запись всех изменений одного листа на другой лист "LOG" в этой же книге.
Как и что изменить чтоб производилась запись только запись из конкретных столбцов например "А", "С" и "Н" а не всех подряд
И еще, Когда произведена запись, в этом листе "LOG" с изменениями пишется название ячейки, которая изменилась. Можно ли это название ячейки сделать ссылкой на ячейку которая изменилась на основном листе ? Мне удалось только в отдельном столбце прописать это формулой но размножить ее не получается т.к. при записи новых изменений макрос начинает писать следующее изменение только в пустой строке после этой заполненной с формулой. т.е приходится только после новых изменений протягивать формулу вниз, Может есть более правильное решение?
Как и что изменить чтоб производилась запись только запись из конкретных столбцов например "А", "С" и "Н" а не всех подряд
И еще, Когда произведена запись, в этом листе "LOG" с изменениями пишется название ячейки, которая изменилась. Можно ли это название ячейки сделать ссылкой на ячейку которая изменилась на основном листе ? Мне удалось только в отдельном столбце прописать это формулой но размножить ее не получается т.к. при записи новых изменений макрос начинает писать следующее изменение только в пустой строке после этой заполненной с формулой. т.е приходится только после новых изменений протягивать формулу вниз, Может есть более правильное решение?
| Код |
|---|
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
For Each rCell In rRng
If Not IsError(rCell) Then sValue = sValue & "," & rCell Else sValue = sValue & "," & "Err"
Next rCell
sValue = Mid(sValue, 2)
Else
If Not IsError(Target) Then sValue = Target.Value Else sValue = "Err"
End If
End Sub |
