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

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


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

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

15   голосов , оценка 4 из 5
Похожие ответы