Как осуществить 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