Доброго времени суток! Дорогие форумчане, помогите, пожалуйста!!
Имеется файл, значения в некоторых ячейках которого периодически изменяются.
Необходимо отслеживать изменения значений(причём некоторые из них с сохранением даты изменения с целью фильтрации по датам).
Изменения(дата изменения значения ячейки) в столбцах "K", "M", "N" фиксируются в столбцах "R", "T" и "U" соответственно.
Делает это вот такой макрос:
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("K2:K5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Now
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("M2:M5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Date
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("N2:N5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Date
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
End Sub
Кроме того, нужно фиксировать изменения в ячейках столбца "O". Здесь достаточно примечания с датой изменения значения ячейки. Для этого используется следующий макрос(взятый с этого сайта) :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewCellValue$, OldComment$
Dim cell As Range
'åñëè ÿ÷åéêà íå â îòñëåæèâàåìîì äèàïàçîíå, òî âûõîäèì
If Intersect(Target, Range("O2:O1600")) Is Nothing Then Exit Sub
'ïåðåáèðàåì âñå ÿ÷åéêè â èçìåíåííîé îáëàñòè
For Each cell In Intersect(Target, Range("O2:O1600"))
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, "DD.MM.YY h:MM") & " : " & NewCellValue
.Comment.Shape.TextFrame.AutoSize = True 'äåëàåì àâòîïîäáîð ðàçìåðà
.Comment.Shape.TextFrame.Characters.Font.Size = 8
End With
Next cell
End Sub
Знаний в Excell почти ноль, поэтому не могу никак их подружить. Вместе просто не работают, ни один, ни второй. Помогите, люди добрые!
Имеется файл, значения в некоторых ячейках которого периодически изменяются.
Необходимо отслеживать изменения значений(причём некоторые из них с сохранением даты изменения с целью фильтрации по датам).
Изменения(дата изменения значения ячейки) в столбцах "K", "M", "N" фиксируются в столбцах "R", "T" и "U" соответственно.
Делает это вот такой макрос:
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("K2:K5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Now
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("M2:M5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Date
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
For Each cell In Target 'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("N2:N5000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 7) 'вводим в соседнюю справа ячейку дату
.Value = Date
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
Next cell
End Sub
Кроме того, нужно фиксировать изменения в ячейках столбца "O". Здесь достаточно примечания с датой изменения значения ячейки. Для этого используется следующий макрос(взятый с этого сайта) :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewCellValue$, OldComment$
Dim cell As Range
'åñëè ÿ÷åéêà íå â îòñëåæèâàåìîì äèàïàçîíå, òî âûõîäèì
If Intersect(Target, Range("O2:O1600")) Is Nothing Then Exit Sub
'ïåðåáèðàåì âñå ÿ÷åéêè â èçìåíåííîé îáëàñòè
For Each cell In Intersect(Target, Range("O2:O1600"))
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, "DD.MM.YY h:MM") & " : " & NewCellValue
.Comment.Shape.TextFrame.AutoSize = True 'äåëàåì àâòîïîäáîð ðàçìåðà
.Comment.Shape.TextFrame.Characters.Font.Size = 8
End With
Next cell
End Sub
Знаний в Excell почти ноль, поэтому не могу никак их подружить. Вместе просто не работают, ни один, ни второй. Помогите, люди добрые!