Доброго времени суток, друзья! Обращаюсь к вам не в первый раз и всегда получаю вашу помощь, за что искренне вас благодарю!
На работе задали интересную задачку:
Имеются две таблицы на листах: "Лоты" и "Отчет". Требуется написать макрос, запускающийся через кнопку на листе "Лоты" или через макросы, который по совпадающим номерам ГПЗ из листа "Отчет" из столбцов 4, 2, 3 запишет соответствующие данные в столбцы 2, 3 и 4 листа "Лоты".
Иными словами: есть 2 таблицы, в каждой из которых есть столбец "Номер ГПЗ". И там, и там номера совпадают, но записаны в разном порядке. Так же в таблице "Отчет" есть сопутствующая информация (столбцы 4, 2, 3), которая должна быть перенесена в таблицу "Лоты" (в столбцы 2, 3 и 4 соответственно). Всё это чудо должно совершаться при нажатии кнопки, которую нужно нарисовать в таблице "Лоты".
ФАЙЛ ПРИЛАГАЕТСЯ
Заранее благодарю!
Доброго времени суток, друзья! Обращаюсь к вам не в первый раз и всегда получаю вашу помощь, за что искренне вас благодарю!
На работе задали интересную задачку:
Имеются две таблицы на листах: "Лоты" и "Отчет". Требуется написать макрос, запускающийся через кнопку на листе "Лоты" или через макросы, который по совпадающим номерам ГПЗ из листа "Отчет" из столбцов 4, 2, 3 запишет соответствующие данные в столбцы 2, 3 и 4 листа "Лоты".
Иными словами: есть 2 таблицы, в каждой из которых есть столбец "Номер ГПЗ". И там, и там номера совпадают, но записаны в разном порядке. Так же в таблице "Отчет" есть сопутствующая информация (столбцы 4, 2, 3), которая должна быть перенесена в таблицу "Лоты" (в столбцы 2, 3 и 4 соответственно). Всё это чудо должно совершаться при нажатии кнопки, которую нужно нарисовать в таблице "Лоты".
Sub Data_Manager() Application.ScreenUpdating = False With ThisWorkbook.Sheets(1)
Dim X As Long 'Пробег по строкам Лотов Dim Y As Long 'Пробег по строкам Отчёта Dim shtX As Worksheet 'Для обращений к листу Отчёты
Set shtX = ThisWorkbook.Sheets(2)
For X = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For Y = 3 To shtX.Cells(Rows.Count, 1).End(xlUp).Row If .Cells(X, 1).Value = shtX.Cells(Y, 1).Value Then .Cells(X, 2).Value = shtX.Cells(Y, 4).Value .Cells(X, 3).Value = shtX.Cells(Y, 2).Value .Cells(X, 4).Value = shtX.Cells(Y, 3).Value Exit For End If Next Y Next X
End With Application.ScreenUpdating = True End Sub
[/vba]
tamerlanishe, здравствуйте.
Предлагаю простенький цикл макросом:
[vba]
Код
Sub Data_Manager() Application.ScreenUpdating = False With ThisWorkbook.Sheets(1)
Dim X As Long 'Пробег по строкам Лотов Dim Y As Long 'Пробег по строкам Отчёта Dim shtX As Worksheet 'Для обращений к листу Отчёты
Set shtX = ThisWorkbook.Sheets(2)
For X = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For Y = 3 To shtX.Cells(Rows.Count, 1).End(xlUp).Row If .Cells(X, 1).Value = shtX.Cells(Y, 1).Value Then .Cells(X, 2).Value = shtX.Cells(Y, 4).Value .Cells(X, 3).Value = shtX.Cells(Y, 2).Value .Cells(X, 4).Value = shtX.Cells(Y, 3).Value Exit For End If Next Y Next X
End With Application.ScreenUpdating = True End Sub
1. На работе? 2. Почему бы не записать рекордером как протянули 3 ВПР() - это тоже будет макрос. 3. Если данных много - то быстрее делать на словаре, ну и массивах - но это вероятно ещё не проходили... Да и решение уже есть.
1. На работе? 2. Почему бы не записать рекордером как протянули 3 ВПР() - это тоже будет макрос. 3. Если данных много - то быстрее делать на словаре, ну и массивах - но это вероятно ещё не проходили... Да и решение уже есть. Hugo