Подскажите, как сделать в VBA. Имеется лист1 с артикулами, лист2 с артикулами ценой и складом. Как найти совпадающие артикулы и подставить значения цены и склада на лист1. Именно VBA, просьба ВПР не предлагать. Спасибо.
Подскажите, как сделать в VBA. Имеется лист1 с артикулами, лист2 с артикулами ценой и складом. Как найти совпадающие артикулы и подставить значения цены и склада на лист1. Именно VBA, просьба ВПР не предлагать. Спасибо.Dilemma086
Sub ее() With Sheets(1) .[b2].CurrentRegion.Resize(, 2).Offset(1, 1).ClearContents For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Set art = Sheets(2).Columns(1).Find(.Cells(i, 1)) If Not art Is Nothing Then Cells(i, 2) = art.Offset(0, 1).Value Cells(i, 3) = art.Offset(0, 2) End If Next i End With End Sub
[/vba]
Dilemma086, так подойдет? [vba]
Код
Sub ее() With Sheets(1) .[b2].CurrentRegion.Resize(, 2).Offset(1, 1).ClearContents For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Set art = Sheets(2).Columns(1).Find(.Cells(i, 1)) If Not art Is Nothing Then Cells(i, 2) = art.Offset(0, 1).Value Cells(i, 3) = art.Offset(0, 2) End If Next i End With End Sub
сдесь в одной строке несколько действий: выделение смежного диапазона к ячейке .[b2] уменьшение его до 2-х столбцов сдвиг на один столбец очистка. Чтобы лучше понять - пройдитесь дебугером(f8) по коду под спойлером и смотрите за изменением выделения на листе.:
[vba]
Код
Sub ее() With Sheets(1) .[b2].CurrentRegion.Select Selection.Resize(, 2).Select Selection.Offset(1, 1).Select Selection.ClearContents For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Set art = Sheets(2).Columns(1).Find(.Cells(i, 1)) If Not art Is Nothing Then Cells(i, 2) = art.Offset(0, 1).Value Cells(i, 3) = art.Offset(0, 2) End If Next i End With End Sub
[/vba]
Правда я не люблю пользоваться CurrentRegion - возможны ошибки, если будут пустые строки. Я - бы заменил эту строку на: [vba]
[/vba] как по мне так и проще для понимания, и точнее
сдесь в одной строке несколько действий: выделение смежного диапазона к ячейке .[b2] уменьшение его до 2-х столбцов сдвиг на один столбец очистка. Чтобы лучше понять - пройдитесь дебугером(f8) по коду под спойлером и смотрите за изменением выделения на листе.:
[vba]
Код
Sub ее() With Sheets(1) .[b2].CurrentRegion.Select Selection.Resize(, 2).Select Selection.Offset(1, 1).Select Selection.ClearContents For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Set art = Sheets(2).Columns(1).Find(.Cells(i, 1)) If Not art Is Nothing Then Cells(i, 2) = art.Offset(0, 1).Value Cells(i, 3) = art.Offset(0, 2) End If Next i End With End Sub
[/vba]
Правда я не люблю пользоваться CurrentRegion - возможны ошибки, если будут пустые строки. Я - бы заменил эту строку на: [vba]
Dilemma086, CurrentRegion - возвращает текущий диапазон для ячейки В2, т.е. диапазон до пустых строк и столбцов, чтобы наглядно посмотреть, можете написать [vba]
Код
[b2].CurrentRegion.select
[/vba] Resize(, 2) - берем только 2 столбца текущего диапазона Offset(1, 1) - сдвигаем все на 1 строчку вниз и на 1 столбец вправо [vba]
[/vba] полученную область очищаем (ClearContents).
Dilemma086, CurrentRegion - возвращает текущий диапазон для ячейки В2, т.е. диапазон до пустых строк и столбцов, чтобы наглядно посмотреть, можете написать [vba]
Код
[b2].CurrentRegion.select
[/vba] Resize(, 2) - берем только 2 столбца текущего диапазона Offset(1, 1) - сдвигаем все на 1 строчку вниз и на 1 столбец вправо [vba]
Sub ee() With Sheets(1) .Range("d2:n" & .Cells(.Rows.Count, "C").End(xlUp).Row).ClearContents For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row Set art = Sheets(2).Columns(4).Find(.Cells(i, "C")) If Not art Is Nothing Then .Cells(i, "g") = Sheets(2).Cells(art.Row, "o").Value .Cells(i, "n") = Sheets(2).Cells(art.Row, "p").Value End If Next i End With End Sub
[/vba]
Вот немного изменил код Manyasha: [vba]
Код
Sub ee() With Sheets(1) .Range("d2:n" & .Cells(.Rows.Count, "C").End(xlUp).Row).ClearContents For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row Set art = Sheets(2).Columns(4).Find(.Cells(i, "C")) If Not art Is Nothing Then .Cells(i, "g") = Sheets(2).Cells(art.Row, "o").Value .Cells(i, "n") = Sheets(2).Cells(art.Row, "p").Value End If Next i End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
