0

Есть две таблицы, где в первой таблице столбец A:A - это критерии поиска, а во второй таблице осуществляется поиск при помощи функции VLOOKUP. Функция работает правильно, но возвращает всегда только первое совпавшее значение, а мне надо, чтобы для каждого критерия в столбце A:A вернулись все значение из таблицы, где осуществляется поиск.

Нашел решение при помощи формулы массива, но оно работает всегда только для одного критерия (который задан статично), а мне нужно тоже самое, только для всех критерий, как при стандартной работе функции VLOOKUP.

введите сюда описание изображения

Первая картинка - это та таблица, где производится поиск. Там есть номера счетов и актуальные остатки.

введите сюда описание изображения

Во второй таблице критерии поиска в столбце акк.намбер. В столбец kbi1 должны возвращаться значения с первой таблицы. Если в первой таблице будет два совпадения, то во второй таблице в столбце kbi1 должно быть два результата друг за другом.

12
  • Если результатов больше одного, куда выводить? Все в одну ячейку? В столбцы правее? 18 июл 2017 в 10:02
  • в идеале так, чтобы они выводились друг за другом(в столбец) то есть вот нашло оно первое совпадение, и вывело в ячейку допустим b3 потом нашло сразу же след. совпадение и вывело в ячейку b4 18 июл 2017 в 10:03
  • Для А3, допустим, выведем в столбец.Но для следующего значения - куда? Вы же написали, что критериев много: "в первой таблице столбец A:A это критерии поиска" Или искомое задается и оно одно? 18 июл 2017 в 10:04
  • допустим сейчас функция смотрит на ячейку критерия a2, там есть какой-то номер счета у которого есть два совпадения, в таблице поиска, первое совпадение будет в b2 а второе совпадение будет в b3 18 июл 2017 в 10:08
  • 1
    ...а теперь смотрит в а3... и куда помещать данные, если b3 уже занято? 18 июл 2017 в 10:11

2 ответа 2

0

VBA поможет.

Sub MultipleSearch()
Dim aNum(), aTabl(), aRes()
Dim i As Long, k As Long, n As Long
    With Worksheets("Лист1") ' лист с таблицей для поиска'
        i = .Cells(.Rows.Count, "A").End(xlUp).Row
        aTabl = .Range("A1:G" & i).Value ' таблица в массив'
        ' в А - счет, в G - остаток'
    End With

    With Worksheets("Лист2") ' лист с таблицей (результат)'
        i = .Cells(.Rows.Count, "D").End(xlUp).Row ' искомые счета в столбце D'
        aNum = .Range("D1:D" & i).Value ' искомые счета в массив'

        ' здесь 3 - максимальное количество возможных значений для одного искомого'
        ReDim aRes(1 To i + 3, 1 To 1) ' задаем размерность массива'
        aRes(1, 1) = .Range("K1").Value ' заголовок столбца К'
    End With

    ' допускаем, что строка 1 - "шапка", ее в обработку не берем'
    For i = 2 To UBound(aNum) ' по искомым данным'
        n = i ' строка для записи найденного'

        For k = 2 To UBound(aTabl) ' по строкам таблицы'
            If aTabl(k, 1) <> Empty Then ' если не пусто'
                If aNum(i, 1) = aTabl(k, 1) Then
                    aRes(n, 1) = aTabl(k, 7): n = n + 1 ' запись найденного'
                End If
            End If
        Next k
    Next i

    ' выгрузка результата на лист в столбец К'
    Worksheets("Лист2").Range("K1").Resize(UBound(aRes), 1).Value = aRes
End Sub

Alt+F11 - вход в редактор VBA. Слева дерево проекта. Добавить общий модуль (Insert-Module), вставить в него код.

На листе создать любой объект(можно через меню Вставка-Фигуры). ПКМ на объекте, Назначить_макрос, в появившемся списке выделить имя макроса, нажать ОК

' -----------------

Можно с помощью формулы. Но на большой таблице возможны тормоза, т.к. формула производит много вычислений. Формула для К2.

 =ЕСЛИОШИБКА(НАИБОЛЬШИЙ(ЕСЛИ(Лист1!$A$2:$A$9=ПРОСМОТР(9E+307;Лист2!$D$1:D2);Лист1!$G$2:$G$9);СТРОКА(A3)-ПОИСКПОЗ(ПРОСМОТР(9E+307;Лист2!$D$1:D2);$D$1:D2;));)

Изменить последнюю строку в диапазонах Лист1!$A$2:$A$9, Лист1!$G$2:$G$9

Вводится как формула массива: находясь в строке формул, нажать одновременно Ctrl+Shift+Enter. Формула должна обрамиться фигурными скобками.

Протянуть формулу по строкам.

Если мешают нули: меню Файл-Параметры-Дополнительно-Показать_параметры_листа, выбрать лист, снять галку Показывать_нули_в_ячейках

Формула работает с искомыми данными в числовом формате. Если счета записаны текстом, то формулу нужно усложнять.

2
  • Добрый вечер. Проверил ваш код. Значения в столбец J(KBI1) возвращаются, но почему-то не в соседнюю ячейку напротив номера счета, а на 3 ячейки ниже. Так же до сих пор не возвращаются значения в случае 2-3 совпадений. В ответ добавлю картинку с результатом и кодом. Спасибо за вашу помощь! 18 июл 2017 в 23:06
  • См. комментарий к Вашему ответу 19 июл 2017 в 7:14
0

введите сюда описание изображения

    Sub MultipleSearch()
Dim bf As Boolean
Dim aNum(), aTabl(), aRes(), aString(), aStatus(), aP()
Dim i As Long, k As Long, n, m As Long
With Worksheets("KBSWG")   ' List s tabulkou, kde se hleda
    i = .Cells(.Rows.Count, "A").End(xlUp).Row
    aTabl = .Range("A1:H" & i).Value ' tabulka do pole
End With

With Worksheets("Accounting output") ' list s tabulkou, kam se zapisuji vysledky
    i = .Cells(.Rows.Count, "D").End(xlUp).Row ' hledane ucty v sloupci D
    aNum = .Range("D1:D" & i).Value 'hledane ucty do pole

' tady 3 je maximalni mnozstvi hodnot pro jednu hledany ucet
    ReDim aRes(1 To i + 3, 1 To 1) ' velikost pole
    aRes(1, 1) = .Range("J1").Value ' zahlavi sloupce
End With

With Worksheets("Accounting output")
    i = .Cells(.Rows.Count, "B").End(xlUp).Row
    aString = .Range("B1:B" & i).Value
End With

With Worksheets("Accounting output")
    i = .Cells(.Rows.Count, "C").End(xlUp).Row
    aStatus = .Range("C1:C" & i).Value
End With

With Worksheets("KBSWG")
    i = .Cells(.Rows.Count, "D").End(xlUp).Row
    aP = .Range("D1:D" & i).Value
End With


For i = 1 To UBound(aNum) ' od 1 do poctu radky tabulky
    n = i 'string pro zapis nalezene hodnoty



    For k = 1 To UBound(aTabl)
      If aString(i, 1) Like "*SumOfMV1*" Then
        If aStatus(i, 1) Like "*BB*" And aP(i, 1) Like "*B*" Or aStatus(i, 1) Like "*BT*" And aP(i, 1) Like "*O*" Then
'If aStatus(i, 1) Like "BB" And aP(i, 1) Like "B" Then bf = True
'If aStatus(i, 1) Like "O" And aP(i, 1) Like "TB" Then bf = True
'If bf Then
           If aTabl(k, 1) <> Empty Then ' kdyz neni prazdna
             If aNum(i, 1) = aTabl(k, 1) Then
               aRes(n, 1) = aTabl(k, 8): n = n + 1 'zapis nalezenych hodnot
'bf = False
        End If
       End If
      End If
     End If

    Next k

Next i

' upload vysledku na list do sloupce J
Worksheets("Accounting output").Range("J1").Resize(UBound(aRes), 1).Value = aRes

End Sub

9
  • For k = 9 To UBound(aTabl) - начало отсчета не ошибочно? Похоже, в диапазоне на KBSWG есть пустоты. В своем коде добавил проверку. ===== Смещение: aTabl берем с первой строки, а выгружаете в J4 (строка перед закрытием процедуры) 19 июл 2017 в 7:08
  • k=9 потому что на листе KBSWG остатки находятся в столбце H и начинаются с 9 ячейки, i = 5 потому что на листе Acc. output запись начинается с 5 ячейки столбца J ( если я правильно понимаю) 19 июл 2017 в 8:23
  • Я дополнил код: If aTabl(k, 1) <> Empty Then...End If. Это для того, чтобы не учитывались пустоты и нормально записывались дубли. О смещении написано в предыдущем комментарии: забирать в массив и выгружать из массива нужно с первой строки 19 июл 2017 в 8:33
  • Спасибо большое. Все работает. Я еще изменил код так, чтобы теперь он смотрел только на строки SumOfMV1. Еще такой вопрос. На листе KBSWG есть столбец P, он принимает только два значения, это либо B(banking) либо O(trading), а на листе acc.output есть столбец Status, в этом столбце все статусы начинаются или на BB(banking) или же на TB(trading). Нужно сделать так чтобы остаток записывался только там, где эти два значения (banking или trading) совпадают. Это как-то возможно? 19 июл 2017 в 10:23
  • Добавить в цикл проверку из двухз If: если там B и если здесь ВВ, то записываем 19 июл 2017 в 10:29

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.