Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Подтягивание информации при одинаковых ячейках - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Подтягивание информации при одинаковых ячейках
franky2118 Дата: Среда, 22.05.2024, 12:13 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Добрый день! В столбце с электронными почтами (ну либо с любой другой информацией, например, ИНН компании), нужно чтобы информация в строке напротив данной почты подтягивалась автоматически, если в новой ячейке в этом же столбце вводишь такую же электронную почту (или ИНН, или любую другую одинаковую информацию). Пример задания во вложении.
К сообщению приложен файл: zadanie.xlsx (8.6 Kb)
 
Ответить
СообщениеДобрый день! В столбце с электронными почтами (ну либо с любой другой информацией, например, ИНН компании), нужно чтобы информация в строке напротив данной почты подтягивалась автоматически, если в новой ячейке в этом же столбце вводишь такую же электронную почту (или ИНН, или любую другую одинаковую информацию). Пример задания во вложении.

Автор - franky2118
Дата добавления - 22.05.2024 в 12:13
Nic70y Дата: Среда, 22.05.2024, 12:35 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 8832
Репутация: 2301 ±
Замечаний: 0% ±

Excel 2010
[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
[/vba]
К сообщению приложен файл: zadanie.xlsm (14.1 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщение[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
[/vba]

Автор - Nic70y
Дата добавления - 22.05.2024 в 12:35
franky2118 Дата: Среда, 22.05.2024, 13:33 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

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 - Среда, 22.05.2024, 13:35
 
Ответить
Сообщение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
Дата добавления - 22.05.2024 в 13:33
Nic70y Дата: Среда, 22.05.2024, 15:59 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 8832
Репутация: 2301 ±
Замечаний: 0% ±

Excel 2010
как-то так
[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
[/vba]


ЮMoney 41001841029809
 
Ответить
Сообщениекак-то так
[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
[/vba]

Автор - Nic70y
Дата добавления - 22.05.2024 в 15:59
franky2118 Дата: Среда, 22.05.2024, 17:25 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, а если у меня столбец не А, а столбец H?
 
Ответить
СообщениеNic70y, а если у меня столбец не А, а столбец H?

Автор - franky2118
Дата добавления - 22.05.2024 в 17:25
franky2118 Дата: Среда, 22.05.2024, 17:26 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, имею в виду столбец с почтой
 
Ответить
СообщениеNic70y, имею в виду столбец с почтой

Автор - franky2118
Дата добавления - 22.05.2024 в 17:26
Nic70y Дата: Среда, 22.05.2024, 17:29 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 8832
Репутация: 2301 ±
Замечаний: 0% ±

Excel 2010
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
заменить на нужные


ЮMoney 41001841029809
 
Ответить
Сообщение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
Дата добавления - 22.05.2024 в 17:29
franky2118 Дата: Четверг, 23.05.2024, 10:17 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, если ставлю столбец H, то копируется только то, что слева от ячейки.
 
Ответить
СообщениеNic70y, если ставлю столбец H, то копируется только то, что слева от ячейки.

Автор - franky2118
Дата добавления - 23.05.2024 в 10:17
Nic70y Дата: Четверг, 23.05.2024, 10:38 | Сообщение № 9
Группа: Друзья
Ранг: Экселист
Сообщений: 8832
Репутация: 2301 ±
Замечаний: 0% ±

Excel 2010
franky2118, я же написал
и соот. здесь
Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value
заменить на нужные


ЮMoney 41001841029809
 
Ответить
Сообщениеfranky2118, я же написал
и соот. здесь
Range("b" & c & ":h" & c) = Range("b" & b & ":h" & b).Value
заменить на нужные

Автор - Nic70y
Дата добавления - 23.05.2024 в 10:38
franky2118 Дата: Четверг, 23.05.2024, 10:44 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, принято, огромное спасибо!
 
Ответить
СообщениеNic70y, принято, огромное спасибо!

Автор - franky2118
Дата добавления - 23.05.2024 в 10:44
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!