Как осуществить LOOK UP в VBA?

Узнай цену своей работы

Формулировка задачи:

Доброго всем времени суток, Прошу помощи в написания макроса , решающим следующую задачу: В одной папке находятся 3 книги excel: 1.) "Исходная таблица": В ней 1 лист - "Помещения", имющий столбцы с заголовками: "Комната №" и "Название" 2.) "Таблица поиска": в ней 2 листа: - лист "Мебель" с заголовками "Комната №" и "Наименование" (вида мебели) - лист "Техника" с теми же заголовками "Комната №" и "Наименование" (вида техники) Таблицы 1.) и 2.) изначально заполнены 3.) Книга "Итоги" - в ней и необходимо прописать макрос VBA - с листом "Итоги" и заголовками "Комната №", "Название", "Наименование" , "Цвет" Строки соответственно пусты (в файле для примера что требуется получить строки заполнены и выделены желтым (т.е. то, что требуется от макроса) Задача макроса: Аналогично методу "LOOK UP" сравнивать значения по номеру помещения из таблицы листа файла 1.) с таблицами на листах файла 2.) и записывать результаты (с пробелом в одну строку между помещениями) в лист таблицы файла 3.) Соответствующие файлы прилагаю

Решение задачи: «Как осуществить LOOK UP в VBA?»

textual
Листинг программы
  1. Sub Заполнить_из_таблиц_поиска()
  2.     Dim i&, j&, k&, MyPath$, A, B, C
  3.     MyPath = ActiveWorkbook.Path
  4.     Application.ScreenUpdating = False
  5.     With Workbooks.Open(FileName:=MyPath & "\Исходная таблица.xlsx", UpdateLinks:=0, ReadOnly:=True)
  6.         A = .Worksheets(1).UsedRange.Value
  7.         .Close SaveChanges:=False
  8.     End With
  9.     With Workbooks.Open(FileName:=MyPath & "\Таблица поиска.xlsx", UpdateLinks:=0, ReadOnly:=True)
  10.         B = .Worksheets("Мебель").UsedRange.Value
  11.         C = .Worksheets("Техника").UsedRange.Value
  12.         .Close SaveChanges:=False
  13.     End With
  14.     k = 1
  15.     With ActiveWorkbook.Sheets("Итоги")
  16.         .UsedRange.Offset(1, 0).ClearContents
  17.         For i = 2 To UBound(A)
  18.             k = k + 1
  19.             .Cells(k, 1) = A(i, 1)
  20.             .Cells(k, 2) = A(i, 2)
  21.             For j = 2 To UBound(B)
  22.                 If B(j, 1) = A(i, 1) Then
  23.                     .Cells(k, 3) = B(j, 2)
  24.                     .Cells(k, 4) = B(j, 3)
  25.                     k = k + 1
  26.                 End If
  27.             Next
  28.             For j = 2 To UBound(C)
  29.                 If C(j, 1) = A(i, 1) Then
  30.                     .Cells(k, 3) = C(j, 2)
  31.                     .Cells(k, 4) = C(j, 3)
  32.                     k = k + 1
  33.                 End If
  34.             Next
  35.         Next i
  36.     End With
  37. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы