Excel VBA: Поиск части текста с помощью макроса.

[Lina]

У меня возник вопрос. Я его оформила в Excel. Сама задача очень просто решается в Excel. Я бы использовала =VLOOKUP("*"&A2&"*";Tabelle2!B:D;3;0).
Но я бы хотела это автоматизировать в макросе. Я пыталась сделать через Formula.R1C1 и Index Match, но насколько я поняла RC не может искать часть текста из ячейки. Есть ли какие-нибудь другие варианты решения этого вопроса?

[вложение удалено администратором]

[Администратор]

Макросы есть двух видов:
1) в виде формулы
2) макросы, которые запускаются кнопкой или другими способами

Вам какой вариант нужен?

[Lina]

второй

[Администратор]

На листе "Tabelle2" в столбце "B" данные находятся всегда после слеша? Если да, то может быть тогда разбивать данные в ячейке по слешу и анализировать вторую часть?

[Lina]

Да, данные всегда после слеша. Поэтому я и подумала вытаскивать их в отдельный столбец.

[Администратор]

Вариант с использованием эксель-функции ВПР (в VBA функция ВПР называется "VLookup").
В вашем файле-примере есть правые концевые пробелы, которые изменяют слова, поэтому нужно сделать так, чтобы не было лишних пробелов.

Макрос

Sub Макрос()
   
    Dim shSrc As Worksheet, shRes As Worksheet
    Dim A(), res()
    Dim lr As Long, i As Long
   
   
    '1. Присваиваем имена листам, с которыми надо работать. Затем
        ' в коде можно удобно обращаться к этим листам.
    Set shRes = Worksheets("Tabelle1")
    Set shSrc = Worksheets("Tabelle2")
   
    '2. Копируем данные из столбца A в массив. Это нужно для ускорения макроса,
        ' т.к. с массивом быстрее работать, чем с эксель-ячейками.
    ' Поиск последней строки. End - не работает со скрытыми строками.
    lr = shRes.Cells(shRes.Rows.Count, "A").End(xlUp).row
    A() = shRes.Range("A2:A" & lr).value
   
    '3. Создание ячеек в массиве-результате. Сначала в него запишутся данные,
        ' а затем массив будет вставлен на лист. Это тоже нужно для ускорения макроса.
    ReDim res(1 To UBound(A, 1), 1 To 1)
   
    '4. Включение перехватчика ошибок. Ошибка будет происходить, если на листе-источнике
        ' нет искомого текста.
    On Error Resume Next
   
    '5. Поиск и запись результата в массив "res".
    For i = 1 To UBound(A, 1)
        res(i, 1) = WorksheetFunction.VLookup("*/" & A(i, 1), shSrc.Columns("B:D"), 3, 0)
    Next i
   
    '6. Отключение перехватчика ошибок.
    On Error GoTo 0
   
    '7. Вставка результата в эксель.
    shRes.Range("C2").Resize(UBound(res, 1)).value = res()
   
End Sub

[свернуть]

[Lina]

Спасибо большое за помощь!