Private Sub Worksheet_Change(ByVal Target As Range) Dim NewCellValue$, OldComment$ Dim cell As Range
'если ячейка не в отслеживаемом диапазоне, то выходим If Intersect(Target, Range("B:J")) Is Nothing Then Exit Sub
'перебираем все ячейки в измененной области For Each cell In Intersect(Target, Range("B:J")) If IsEmpty(cell) Then NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки Else NewCellValue = cell.Formula 'или ее содержимое End If On Error Resume Next
With cell OldComment = .Comment.Text & Chr(10) .Comment.Delete 'удаляем старое примечание (если было) .AddComment 'добавляем новое и вводим в него текст .Comment.Text Text:=OldComment & Application.UserName & " " & _ Format(Now) & " : " & NewCellValue .Comment.Shape.TextFrame.AutoSize = True 'делаем автоподбор размера .Comment.Shape.TextFrame.Characters.Font.Size = 8 End With Next cell If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 36) If IsEmpty(.Value) Then .Value = Date End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 44) If IsEmpty(.Value) Then .Value = Time End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 52) .Value = Date End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 60) .Value = Time End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 68) .Value = NewCellValue End With End If End Sub
Мне нужно изменить последний макрос чтобы она каждый раз при введении нового значения фиксировала каждый раз в новую ячейку то есть сохранялась история следующего содержания "пользователь дата время значение"
так же хочу добавить в этот макрос защиту всех ячеек без заливки
Здравствуйте! Есть макрос:
Private Sub Worksheet_Change(ByVal Target As Range) Dim NewCellValue$, OldComment$ Dim cell As Range
'если ячейка не в отслеживаемом диапазоне, то выходим If Intersect(Target, Range("B:J")) Is Nothing Then Exit Sub
'перебираем все ячейки в измененной области For Each cell In Intersect(Target, Range("B:J")) If IsEmpty(cell) Then NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки Else NewCellValue = cell.Formula 'или ее содержимое End If On Error Resume Next
With cell OldComment = .Comment.Text & Chr(10) .Comment.Delete 'удаляем старое примечание (если было) .AddComment 'добавляем новое и вводим в него текст .Comment.Text Text:=OldComment & Application.UserName & " " & _ Format(Now) & " : " & NewCellValue .Comment.Shape.TextFrame.AutoSize = True 'делаем автоподбор размера .Comment.Shape.TextFrame.Characters.Font.Size = 8 End With Next cell If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 36) If IsEmpty(.Value) Then .Value = Date End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 44) If IsEmpty(.Value) Then .Value = Time End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 52) .Value = Date End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 60) .Value = Time End With End If If Not Intersect(Target, Range("B:J")) Is Nothing Then With Target.Offset(0, 68) .Value = NewCellValue End With End If End Sub
Мне нужно изменить последний макрос чтобы она каждый раз при введении нового значения фиксировала каждый раз в новую ячейку то есть сохранялась история следующего содержания "пользователь дата время значение"
так же хочу добавить в этот макрос защиту всех ячеек без заливкиProtAleks