Использование VBA - Вставка VLOOKUP в зависимости от определенных значений

Question

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

OLY

OLY - QUO

OLY - PRO

---

у меня есть следующие, и знаю, что это не правильно

Sub BlockAllocationsVlookupAll() 

Dim x As Long 
For x = 1 To 65536 

If InStr(1, Sheet1.Range("$H$" & x), "OLY") > 0 Then 
Sheet1.Range("$I$" & x) = Sheet1.Range("$I$" & x) & "sometext" 
End If 
Next 

End Sub 

Я знаю, что выше не делать то, что мне нужно кто может помочь, как к тому, что должно быть отредактирован, чтобы включить ВПР ниже

=VLOOKUP(A21,'[001 - Allocations - Blocks.xls]CurrentDayAll'!$1:$65536,9,FALSE) 

Другой вопрос, что клетки ВПР указывает на первый также будет меняться из-за разной длины отчета

Спасибо за любую помощь, оказанную

Answer 1

UPD:

Как следует вверх от комментариев,

• колонка H в книге Allocations.xls
• есть набор критериев
• формула должна быть помещена в клетке только в том случае, соответствующей ячейки в колонке H матчей любой из этих критериев.

---

Рабочий код:

Sub BlockAllocationsVlookupAll() 

    Dim x As Long 
    Dim lastrow As Long 
    Dim searchCriterias As String 
    Dim wb As Workbook 
    Dim ws As Worksheet 

    'specify correct path to your workbook 
    Set wb = Workbooks.Open("C:\Allocations.xls") 
    'If workbook is already opened use next line 
    'Set wb = Workbooks("Allocations.xls") 
    Set ws = wb.Worksheets("Current Day") 

    searchCriterias = "|OLY|SVC|SVC-PRO|SVC-QUO|EUR|EUR-PRO|EUR-QUO|" 

    With ws 
     lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row 

     For x = 4 To lastrow 
      If InStr(1, searchCriterias, "|" & .Range("H" & x) & "|") > 0 Then 
       .Range("I" & x).Formula = "=VLOOKUP(A" & x & ",'[001 - Allocations - Blocks.xls]CurrentDayAll'!$A:$I,9,FALSE)" 
      End If 
     Next 
    End With 

    'Comment next line if you don't want to close wb 
    wb.Close (True) 
    Set wb = Nothing 
End Sub