Как осуществить LOOK UP в VBA?
Формулировка задачи:
Доброго всем времени суток,
Прошу помощи в написания макроса , решающим следующую задачу:
В одной папке находятся 3 книги excel:
1.) "Исходная таблица": В ней 1 лист - "Помещения", имющий столбцы с заголовками:
"Комната №" и "Название"
2.) "Таблица поиска": в ней 2 листа:
- лист "Мебель" с заголовками "Комната №" и "Наименование" (вида мебели)
- лист "Техника" с теми же заголовками "Комната №" и "Наименование" (вида техники)
Таблицы 1.) и 2.) изначально заполнены
3.) Книга "Итоги" - в ней и необходимо прописать макрос VBA - с листом "Итоги" и заголовками "Комната №", "Название", "Наименование" , "Цвет"
Строки соответственно пусты (в файле для примера что требуется получить строки заполнены и выделены желтым (т.е. то, что требуется от макроса)
Задача макроса: Аналогично методу "LOOK UP" сравнивать значения по номеру помещения из таблицы листа файла 1.) с таблицами на листах файла 2.) и записывать результаты (с пробелом в одну строку между помещениями) в лист таблицы файла 3.)
Соответствующие файлы прилагаю
Решение задачи: «Как осуществить LOOK UP в VBA?»
textual
Листинг программы
Sub Заполнить_из_таблиц_поиска() Dim i&, j&, k&, MyPath$, A, B, C MyPath = ActiveWorkbook.Path Application.ScreenUpdating = False With Workbooks.Open(FileName:=MyPath & "\Исходная таблица.xlsx", UpdateLinks:=0, ReadOnly:=True) A = .Worksheets(1).UsedRange.Value .Close SaveChanges:=False End With With Workbooks.Open(FileName:=MyPath & "\Таблица поиска.xlsx", UpdateLinks:=0, ReadOnly:=True) B = .Worksheets("Мебель").UsedRange.Value C = .Worksheets("Техника").UsedRange.Value .Close SaveChanges:=False End With k = 1 With ActiveWorkbook.Sheets("Итоги") .UsedRange.Offset(1, 0).ClearContents For i = 2 To UBound(A) k = k + 1 .Cells(k, 1) = A(i, 1) .Cells(k, 2) = A(i, 2) For j = 2 To UBound(B) If B(j, 1) = A(i, 1) Then .Cells(k, 3) = B(j, 2) .Cells(k, 4) = B(j, 3) k = k + 1 End If Next For j = 2 To UBound(C) If C(j, 1) = A(i, 1) Then .Cells(k, 3) = C(j, 2) .Cells(k, 4) = C(j, 3) k = k + 1 End If Next Next i End With End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д