Страницы: 1
RSS
[ Закрыто ] Как "подружить" макросы, Не работают вместе два макроса, подскажите как их подружить
 
  Доброго времени суток! Дорогие форумчане, помогите,  пожалуйста!!  
  Имеется файл, значения в некоторых ячейках которого периодически изменяются.
Необходимо отслеживать изменения значений(причём некоторые из них с сохранением даты изменения с целью фильтрации по датам).
Изменения(дата изменения значения ячейки) в столбцах "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 почти ноль, поэтому не могу никак их подружить. Вместе просто не работают, ни один, ни второй. Помогите, люди добрые!
 
Название темы "ни в дугу", файла-примера нет.
Код в сообщении следует оформлять кнопкой <...>

Но главное - при регистрации нужно читать правила
Страницы: 1
Наверх