Страницы: 1
RSS
Application.VLookup если содержит
 
Доброго времени суток!

Есть таблица с наименованиями :
G1
G2
G3
D1
...

Так же есть таблица соответсвий - наименование и его позиция, но в данном случае наименования через запятую.
G1,D1,D2        1
G2,D2,D3        2
Из второй таблицы в первую подтягиваю наименования формулой  =VLOOKUP("*"&D64&"*",$A$91:$B$93,2,0).
И все работает, но проблема в том, что месторасположение данных таблиц на листе может меняться, формулу каждый раз придется прописывать заного, поэтому принял решение написать код в VBA который бы мог искать таблицы по заголовкам,а потом подтягивал бы данные из 2 в 1 таблицу.

Столкнулся с проблемой, что в первую таблицу данные подтягиваются не совсем корректо, файл пример прилагаю.
Прошу помочь кто встречался с подобным, возможно мой вариант поиска координат таблиц не самый правильный, если есть идеи прошу поделиться.  
Изменено: Walkish - 19.09.2020 22:59:38
 
используйте именованный диапазон для таблиц или умные таблицы.
По вопросам из тем форума, личку не читаю.
 
Можно пример?
Дело в том, что листов много и на каждом эти таблички в разных местах, не хотелось бы создавать для каждого листа все отдельно..
 
сможете описать задачу - может и решение найдется
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Задача подтягивать из второй таблицы в первую данные.
В файле примере я изменил всю ненужную к вопросу инфу звездочками, именно в таком виде данные таблицы приходят.
Конкретно в этом примере таблица1 начинается с 63 строки, но может быть и 73, всегда по разному, поэтому я и определяю ее по условию(во вложении макрос где все есть).
Загвоздка в том, что неккоректно отрабатывает функция Application.VLookup , в обычной формуле ВПР я могу добавить  к просматриваему элементу "*" & & "*", чтобы искать вхождения этого элемента в строке.
Как это повторить с Application.VLookup вот вопрос..
Изменено: Walkish - 20.09.2020 00:46:57
 
Код
Sub FindNums()
  Dim rg1 As Range, rg As Range, r&, c&
  Set rg1 = Cells.Find("Id", Cells(1), xlValues, xlWhole)
  If rg1 Is Nothing Then Exit Sub
  r = rg1.Row + 1: c = rg1.Column + 2
  Set rg1 = Cells.Find("Номер", rg1.Offset(1, 0))
  If rg1 Is Nothing Then Exit Sub Else Set rg1 = rg1.Offset(0, -1).Resize(99, 1)
  Do While Not IsEmpty(Cells(r, c))
    Set rg = rg1.Find(Cells(r, c), lookat:=xlPart)
    If Not rg Is Nothing Then Cells(r, c + 2) = rg.Offset(0, 1)
    r = r + 1
  Loop
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Предложите понятное название темы. Заменят модераторы
 
Ігор Гончаренко, работает!
Не пойму только каким образом :D , если есть такая возможность могли бы оставить комментарии?
Спасибо огромное!
Изменено: Walkish - 20.09.2020 13:41:38
 
vikttur, честно говоря я потратил уйму времени чтобы что то похожее найти в интернете, но так и не смог четко сформулировать..  
Страницы: 1
Наверх