Доброе времени суток.
Прошу помощи в...
Имею две проблемы, и две нерешенные формулы, кто может сталкивался или сможет помочь, а кому надо пожалуйста пользуйтесь 1-м вариантом если Вам не надо вкладывать дату в 2-ве и более ячейки она работает норм. И так...
Способ №1
Если ввожу дату вручную в столбик А4 по А15 то в столбце G4 по G15 автоматически и беспроблемно вводиться эта дата, при изменении даты в столбце А2 по А15 вручную то опять автоматически и беспроблемно вводится дата в следующую пустую колонку, если сделать Ctrl+С и выделить колонки А2 по А15 нажать Ctrl+V, то дата будет записана в G4-H4-I4-J4... и так далее вместо G5-G6-G7...
Способ №2
Или может как то объединить формулу которая будет вписывать дату в ячейке B5-B6-B7 оттуда моя формула будет уже автоматически видеть дату как вписанную в ручную в каждую ячейку и записывать по вертикали в следующею свободную ячейку G5-G6-G7... так я пробовал но не могу запустить сразу две формулы для работы с параллельными ячейками
Прошу помощи в...
Имею две проблемы, и две нерешенные формулы, кто может сталкивался или сможет помочь, а кому надо пожалуйста пользуйтесь 1-м вариантом если Вам не надо вкладывать дату в 2-ве и более ячейки она работает норм. И так...
Способ №1
Если ввожу дату вручную в столбик А4 по А15 то в столбце G4 по G15 автоматически и беспроблемно вводиться эта дата, при изменении даты в столбце А2 по А15 вручную то опять автоматически и беспроблемно вводится дата в следующую пустую колонку, если сделать Ctrl+С и выделить колонки А2 по А15 нажать Ctrl+V, то дата будет записана в G4-H4-I4-J4... и так далее вместо G5-G6-G7...
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range) Dim NewCellValue$, OldComment$ Dim cell As Range 'если ячейка не в отслеживаемом диапазоне, то выходим If Intersect(Target, Range("A4:A2000")) Is Nothing Then Exit Sub 'перебираем все ячейки в измененной области For Each cell In Intersect(Target, Range("A4:A2000")) If IsEmpty(cell) Then NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки Else NewCellValue = cell.Formula 'или ее содержимое End If On Error Resume Next With cell End With ' ============================================== ' дополнительый блок ' ============================================== Row_ = Target.Row ' запоминаем текущую строку на данной странице. такая же строка будет и на странице истории обслуживания Col_ = 5 ' устанавливаем крайний левый столбец. Do While "" <> Sheets("Лист1").Cells(Row_, Col_).Text ' в цикле считаем заполненные столбцы от крайнего левого столбца. Находим крайний левый пустой столбец на странице истории Col_ = Col_ + 1 Loop ' записываем в пустой столбец на странице истории историю изменения. Тут ее можно компоновать как хочется. Sheets("Лист1").Cells(Row_, Col_) = Format(NewCellValue, "DD.MM.YY") ' ============================================== ' конец дополнительного блока ' ============================================== Next cell End Sub |
Способ №2
Или может как то объединить формулу которая будет вписывать дату в ячейке B5-B6-B7 оттуда моя формула будет уже автоматически видеть дату как вписанную в ручную в каждую ячейку и записывать по вертикали в следующею свободную ячейку G5-G6-G7... так я пробовал но не могу запустить сразу две формулы для работы с параллельными ячейками
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range) Dim NewCellValue$, OldComment$ Dim cell As Range 'если ячейка не в отслеживаемом диапазоне, то выходим If Intersect(Target, Range("B4:B2000")) Is Nothing Then Exit Sub 'перебираем все ячейки в измененной области For Each cell In Intersect(Target, Range("B4:B2000")) If IsEmpty(cell) Then NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки Else NewCellValue = cell.Formula 'или ее содержимое End If On Error Resume Next With cell End With ' ============================================== ' дополнительый блок ' ============================================== Row_ = Target.Row ' запоминаем текущую строку на данной странице. такая же строка будет и на странице истории обслуживания Col_ = 4 ' устанавливаем крайний левый столбец. ВНИМАНИЕ! Если вы удалите столбец 5 на странице истории, надо установить эту константу на 1 меньше! Do While "" <> Sheets("Лист1").Cells(Row_, Col_).Text ' в цикле считаем заполненные столбцы от крайнего левого столбца. Находим крайний левый пустой столбец на странице истории Col_ = Col_ + 1 Loop ' записываем в пустой столбец на странице истории историю изменения. Тут ее можно компоновать как хочется. Sheets("Лист1").Cells(Row_, Col_) = Format(NewCellValue, "DD.MM.YY") ' ============================================== ' конец дополнительного блока ' ============================================== Next cell For Each cell In Target 'проходим по всем измененным ячейкам If Not Intersect(cell, Range("A4:A100")) Is Nothing Then 'если изменененная ячейка попадает в диапазон With cell.Offset(0, 1) 'вводим в соседнюю справа ячейку дату .Value = Now .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке End With End If Next cell End Sub |