Добрый день! В столбце с электронными почтами (ну либо с любой другой информацией, например, ИНН компании), нужно чтобы информация в строке напротив данной почты подтягивалась автоматически, если в новой ячейке в этом же столбце вводишь такую же электронную почту (или ИНН, или любую другую одинаковую информацию). Пример задания во вложении.
Добрый день! В столбце с электронными почтами (ну либо с любой другой информацией, например, ИНН компании), нужно чтобы информация в строке напротив данной почты подтягивалась автоматически, если в новой ячейке в этом же столбце вводишь такую же электронную почту (или ИНН, или любую другую одинаковую информацию). Пример задания во вложении.franky2118
Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("a1:a" & a), 0) If IsNumeric(b) Then c = Target.Row Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value End If End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("a1:a" & a), 0) If IsNumeric(b) Then c = Target.Row Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value End If End If End Sub
Nic70y, благодарю! А если у меня уже стоит макрос:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) For Each cell In Target 'проходим по всем измененным ячейкам If Not Intersect(cell, Range("N2:N500")) Is Nothing Then 'если измененная ячейка With cell.Offset(0, 3) 'вводим в соседнюю справа ячейку дату .Value = Now .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B чтобы дата умещалась в ячейке End With End If Next cell End Sub
[/vba]
Я просто нажимаю Enter и вставляю ваш новый?
Nic70y, благодарю! А если у меня уже стоит макрос:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) For Each cell In Target 'проходим по всем измененным ячейкам If Not Intersect(cell, Range("N2:N500")) Is Nothing Then 'если измененная ячейка With cell.Offset(0, 3) 'вводим в соседнюю справа ячейку дату .Value = Now .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B чтобы дата умещалась в ячейке End With End If Next cell End Sub
[/vba]
Я просто нажимаю Enter и вставляю ваш новый?franky2118
Сообщение отредактировал franky2118 - Среда, 22.05.2024, 13:35
Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("a1:a" & a), 0) If IsNumeric(b) Then c = Target.Row Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value End If End If For Each cell In Target 'проходим по всем измененным ячейкам If Not Intersect(cell, Range("N2:N500")) Is Nothing Then 'если измененная ячейка With cell.Offset(0, 3) 'вводим в соседнюю справа ячейку дату .Value = Now .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B чтобы дата умещалась в ячейке End With End If Next cell End Sub
[/vba]
как-то так [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("a1:a" & a), 0) If IsNumeric(b) Then c = Target.Row Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value End If End If For Each cell In Target 'проходим по всем измененным ячейкам If Not Intersect(cell, Range("N2:N500")) Is Nothing Then 'если измененная ячейка With cell.Offset(0, 3) 'вводим в соседнюю справа ячейку дату .Value = Now .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B чтобы дата умещалась в ячейке End With End If Next cell End Sub
a = Cells(Rows.Count, "h").End(xlUp).Row If Not Intersect(Target, Range("h2:h" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("h1:h" & a), 0) и соот. здесь Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value заменить на нужные
a = Cells(Rows.Count, "h").End(xlUp).Row If Not Intersect(Target, Range("h2:h" & a)) Is Nothing Then b = Application.Match(Target.Value, Range("h1:h" & a), 0) и соот. здесь Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value заменить на нужныеNic70y
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
