Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вывод текущей даты при заполнения ячейки
 
#1
12.01.2022 12:44:34
Здравствуйте, подскажите пожалуйста.

Ниже код, который используется для вывода текущей даты при заполнении ячеек в определенном диапазоне, как можно модернизировать данный код, что бы можно было помимо диапазона F:F и вводя дату в соседнюю ячейку еще и заполняя данные в диапазоне H:H вводить в соседнюю ячейку текущую дату?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
     
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("F:F")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
               .Value = Now
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
    Next cell
End Sub
 
 
 
#2
12.01.2022 13:41:36
:)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
      
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("F:F")) Is Nothing Then  'если изменененная ячейка попадает в диапазон f:f
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
               .Value = Now
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца f+1, чтобы дата умещалась в ячейке
            End With
       End If
       If Not Intersect(cell, Range("h:h")) Is Nothing Then  'если изменененная ячейка попадает в диапазон h:h
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
               .Value = Now
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца h+1, чтобы дата умещалась в ячейке
            End With
        End If
    Next cell
End Sub
 
 
 
#3
12.01.2022 13:50:37
или так
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iCell As Range, Rng As Range
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = Empty Then Exit Sub
    Set Rng = Union(Range("F:F"), Range("H:H"))
    For Each iCell In Target      'проходим по всем измененным ячейкам
        If Not Intersect(iCell, Rng) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
            Application.EnableEvents = False
            With iCell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
                .Value = Now
                '.EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца, чтобы дата умещалась в ячейке
            End With
            Application.EnableEvents = True
        End If
    Next iCell
End Sub
Изменено: New - 12.01.2022 13:50:47
 
 
 
#4
12.01.2022 17:07:23
Спасибо большое!
Изменено: xxx996 - 12.01.2022 21:30:39
 
 
 
Страницы: 1
Наверх